834 lines
30 KiB
Perl
834 lines
30 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: List.pm,v 1.50 2004/11/04 17:54:05 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::List;
|
|
# ==================================================================
|
|
|
|
use strict;
|
|
use GList qw/:objects :user_type $DEBUG/;
|
|
use GT::AutoLoader;
|
|
|
|
sub process {
|
|
#-------------------------------------------------------------------
|
|
# Setermine 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 ||= 'lst_home.html';
|
|
$MN_SELECTED = 2;
|
|
|
|
my $hidden = GList::hidden();
|
|
$results->{hidden_query} = $hidden->{hidden_query};
|
|
$results->{hidden_objects} = $hidden->{hidden_objects};
|
|
GList::display($tpl, $results);
|
|
}
|
|
|
|
$COMPILE{lst_home} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_home {
|
|
#--------------------------------------------------------------------
|
|
# Print home page
|
|
#
|
|
my $msg = shift;
|
|
my $cgi = $IN->get_hash;
|
|
if (defined $cgi->{do} and $cgi->{do} =~ /^lst_add|lst_modify|lst_html/) {
|
|
foreach ( $DB->table('Lists')->cols ) { $cgi->{$_} = ''; }
|
|
}
|
|
my $search_check = ($IN->param('do') eq 'lst_search') ? 1 : 0;
|
|
my $query = '';
|
|
if ($cgi->{'lst_date_created-ge'} or $cgi->{'lst_date_created-le'}) {
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
my ($valid_from, $valid_to) = (1, 1);
|
|
require GT::Date;
|
|
if ($cgi->{'lst_date_created-ge'}) {
|
|
$query .= "lst_date_created-ge=$cgi->{'lst_date_created-ge'};";
|
|
$valid_from = GList::date_to_time($cgi->{'lst_date_created-ge'}, $format);
|
|
$cgi->{'lst_date_created-ge'} = GT::Date::date_get($valid_from, $format);
|
|
}
|
|
if ($cgi->{'lst_date_created-le'}) {
|
|
$query .= "lst_date_created-le=$cgi->{'lst_date_created-le'};";
|
|
$valid_to = GList::date_to_time($cgi->{'lst_date_created-le'}, $format);
|
|
$cgi->{'lst_date_created-le'} = GT::Date::date_get($valid_to, $format);
|
|
}
|
|
|
|
if ($search_check and (!$valid_from or !$valid_to)) {
|
|
$format =~ s/\%//g;
|
|
return lst_search_form(GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')));
|
|
}
|
|
}
|
|
my $results = GList::search(
|
|
cgi => $cgi,
|
|
db => $DB->table('Lists'),
|
|
prefix => 'lst',
|
|
sb => 'lst_title',
|
|
so => 'ASC',
|
|
search_check=> $search_check,
|
|
select_all => $cgi->{select_all}
|
|
);
|
|
|
|
if (ref $results ne 'HASH') {
|
|
($IN->param('do') eq 'lst_search') ? return (lst_search_form($results))
|
|
: return ('lst_home.html', { msg => $results });
|
|
}
|
|
elsif ($results->{error} and $search_check) {
|
|
return lst_search_form($results->{error});
|
|
}
|
|
|
|
require GT::SQL::Condition;
|
|
my $subs = $DB->table('Subscribers');
|
|
my $output = $results->{results};
|
|
my @lists = map $_->{lst_id}, @$output;
|
|
|
|
$subs->select_options("GROUP BY sub_list_id_fk");
|
|
my %subscribers = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists })->fetchall_list;
|
|
|
|
$subs->select_options("GROUP BY sub_list_id_fk");
|
|
my %validateds = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists, sub_validated => 1 })->fetchall_list;
|
|
|
|
$subs->select_options("GROUP BY sub_list_id_fk");
|
|
my %bounceds = $subs->select(sub_list_id_fk => 'COUNT(*)', GT::SQL::Condition->new(sub_list_id_fk => 'IN' => \@lists, sub_bounced => '>=' => 1))->fetchall_list;
|
|
|
|
foreach my $rs (@$output) {
|
|
$rs->{subscribers} = $subscribers{$rs->{lst_id}};
|
|
$rs->{validateds} = $validateds{$rs->{lst_id}};
|
|
$rs->{bounceds} = $bounceds{$rs->{lst_id}};
|
|
}
|
|
|
|
if ($cgi->{select_all}) {
|
|
my $sorted = _qsort($results->{results}, $cgi->{sb}, ($cgi->{so} eq 'ASC') ? 1 : 0);
|
|
my @sorted;
|
|
my $mh = $results->{mh};
|
|
my $nh = $results->{nh} || 1;
|
|
my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh;
|
|
my $count = 0;
|
|
if ( $bg < $results->{hits} ) {
|
|
foreach my $i (0..($results->{hits} - 1)) {
|
|
if ($i >= $bg) {
|
|
push @sorted, $sorted->[$i];
|
|
last if ($#sorted == $mh - 1);
|
|
}
|
|
}
|
|
$results->{results} = \@sorted;
|
|
}
|
|
else {
|
|
$results->{results} = [];
|
|
}
|
|
}
|
|
$results->{msg} = $msg if ($msg);
|
|
return ('lst_home.html', { %$results, toolbar_query => $query });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_add} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_add {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
return ('lst_add_form.html') if ($IN->param('form'));
|
|
|
|
# Check account limit if it's a limited user
|
|
if ($USER->{usr_type} == LIMITED_USER and GList::check_limit('list')) {
|
|
return lst_home($GList::error);
|
|
}
|
|
|
|
my $ret = GList::add('Lists', 'lst');
|
|
return ('lst_add_form.html', { msg => "<font color=red>$GList::error</font>", help => 'lists_add.html' }) if ( $GList::error );
|
|
|
|
my $name = $IN->param('lst_title');
|
|
return lst_home(GList::language('LST_ADD_SUCCESS', $name));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_modify_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_modify_form {
|
|
#--------------------------------------------------------------------
|
|
# Print modify form
|
|
#
|
|
my $msg = shift;
|
|
|
|
return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));
|
|
|
|
my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
|
|
return home($info) if (ref $info ne 'HASH');
|
|
|
|
return ('lst_modify_form.html', { msg => $msg, %$info, help => 'lists_add.html' });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_modify} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_modify {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
GList::modify('Lists', 'lst');
|
|
return lst_modify_form("<font color=red>$GList::error</font>") if ( $GList::error );
|
|
|
|
my $title = $IN->param('lst_title');
|
|
lst_home(GList::language('LST_MOD_SUCCESS', $title));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_search_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_search_form {
|
|
#--------------------------------------------------------------------
|
|
# Print add form
|
|
#
|
|
my $msg = shift;
|
|
return ('lst_search_form.html', { msg => $msg });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_delete} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_delete {
|
|
#--------------------------------------------------------------------
|
|
# Delete lists
|
|
#
|
|
return lst_home(GList::delete('Lists', 'lst'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_html} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_html {
|
|
#-----------------------------------------------------------------
|
|
#
|
|
return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));
|
|
|
|
my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
|
|
return lst_home($info) if (ref $info ne 'HASH');
|
|
|
|
my $msg = $CFG->{html_code};
|
|
$msg =~ s/<%name%>/$info->{lst_title}/;
|
|
$msg =~ s/<%id%>/$info->{lst_id}/;
|
|
$msg =~ s/<%url%>/$CFG->{cgi_url}\/glist.cgi/;
|
|
return ('lst_html.html', { msg => $msg, lst_title => $info->{lst_title} });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_import} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_import {
|
|
#-----------------------------------------------------------------
|
|
# Import data into subcribers table
|
|
#
|
|
return ('lst_import_form.html', { help => 'lists_import.html' }) if ($IN->param('form'));
|
|
|
|
my $data = $IN->param('sub_file') || $IN->param('sub_data');
|
|
return ('lst_import_form.html', { msg => GList::language('LST_IPT_INVALID'), help => 'lists_import.html' }) unless ($data);
|
|
return ('lst_import_form.html', { msg => GList::language('LST_IPT_LIST_EMPTY'), help => 'lists_import.html' }) unless ($IN->param('import_to'));
|
|
|
|
my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
|
|
my $fd = $IN->param('fd') || ',';
|
|
my $fe = $IN->param('fe') || '\\';
|
|
my $rd = $IN->param('rd') || '\n';
|
|
my $rl = $IN->param('rl') || 0;
|
|
|
|
# Setup the language for GT::SQL.
|
|
local $GT::SQL::ERRORS->{UNIQUE} = GList::language('LST_IPT_DUPLICATE_EMAIL');
|
|
local $GT::SQL::ERRORS->{NOTNULL} = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
|
|
local $GT::SQL::ERRORS->{ILLEGALVAL} = '';
|
|
|
|
my (@data, @results);
|
|
if ($IN->param('sub_file')) { # from a text file
|
|
my $file_name = $data;
|
|
$file_name =~ s/.*?([^\\\/:]+)$/$1/;
|
|
$file_name =~ s/[\[\]\s\$\#\%'"]/\_/g;
|
|
$file_name = "$CFG->{priv_path}/tmp/$file_name";
|
|
open (OUTFILE, "> $file_name") ;
|
|
binmode(OUTFILE);
|
|
my ($bytesread, $buffer, $count);
|
|
while ($bytesread = read($data, $buffer, 1024)) {
|
|
$buffer =~ s,\r\n,\n,g;
|
|
print OUTFILE $buffer;
|
|
}
|
|
close OUTFILE;
|
|
|
|
if (!-T $file_name) {
|
|
unlink $file_name;
|
|
return lst_import_form(GList::language('LST_IPT_INVALID_FILE'));
|
|
}
|
|
|
|
open (DATA, "< $file_name");
|
|
my @lines = <DATA>;
|
|
close DATA;
|
|
unlink $file_name;
|
|
|
|
LINE: foreach (@lines) {
|
|
$count++;
|
|
( /^#/ ) and next LINE;
|
|
( /^\s*$/ ) and next LINE;
|
|
( $count eq $rl ) and next LINE;
|
|
push @data, $_;
|
|
}
|
|
}
|
|
else { # from listings
|
|
@data = split(/$rd/, $data);
|
|
}
|
|
foreach my $id (@$import_to) {
|
|
my $results = _import_subscriber($id, \@data);
|
|
if (ref $results eq 'HASH') {
|
|
push @results, $results;
|
|
}
|
|
else {
|
|
push @results, { lst_id => $id, error => $results };
|
|
}
|
|
}
|
|
return ('lst_import_success.html', { import_results => \@results });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_import_subscriber} = __LINE__ . <<'END_OF_SUB';
|
|
sub _import_subscriber {
|
|
#-----------------------------------------------------------------
|
|
#
|
|
my ($list_id, $data) = @_;
|
|
|
|
# Verify data before importing
|
|
return GList::language('LST_INVALID') if (!$list_id or !$data);
|
|
|
|
my $info = GList::check_owner('Lists', 'lst', $list_id);
|
|
return $info if (ref $info ne 'HASH');
|
|
|
|
if (GList::check_limit('sublist', $list_id)) {
|
|
return { list_name => $info->{lst_title}, overlimit => 1 };
|
|
}
|
|
my $db = $DB->table('Subscribers');
|
|
my $fd = $IN->param('fd') || ',';
|
|
my $fe = $IN->param('fe') || '\\';
|
|
my $rd = $IN->param('rd') || '\n';
|
|
my $rl = $IN->param('rl') || 0;
|
|
|
|
# Create stoplist database and load wild cards
|
|
my $db_stl = $DB->table('StopLists');
|
|
my $wild_cards = GList::wild_cards();
|
|
|
|
my @results;
|
|
my ($invalid, $duplicate) = (0, 0);
|
|
foreach my $row ( @$data ) {
|
|
$row =~ s/[\r\n\"]//g; # Remove Windows linefeed character.
|
|
if ($IN->param('cname')) {
|
|
my ($n, $e) = split(/$fd/, $row);
|
|
$e = $1 if ($e =~ /<([^> ]+)>/);
|
|
$e = lc $e;
|
|
my $error = _check_subscriber($e, $list_id, $db_stl, $wild_cards);
|
|
if ($error) {
|
|
push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => $error };
|
|
$invalid++;
|
|
}
|
|
else {
|
|
push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => '' };
|
|
if ($db->count({ sub_email => $e, sub_list_id_fk => $list_id })) {
|
|
$db->update({ sub_name => $n }, { sub_email => $e, sub_list_id_fk => $list_id }) if $n;
|
|
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
|
$duplicate++;
|
|
}
|
|
else {
|
|
$db->insert({ sub_email => $e, sub_name => $n, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
$row = $1 if ($row =~ /<([^> ]+)>/);
|
|
$row = lc $row;
|
|
my $error = _check_subscriber($row, $list_id, $db_stl, $wild_cards);
|
|
if ($error) {
|
|
push @results, { list_name => $info->{lst_title}, sub_email => $row, status => $error };
|
|
$invalid++;
|
|
}
|
|
else {
|
|
push @results, { list_name => $info->{lst_title}, sub_email => $row, status => '' };
|
|
if ($db->count({ sub_email => $row, sub_list_id_fk => $list_id })) {
|
|
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
|
$duplicate++;
|
|
}
|
|
else {
|
|
$db->insert({ sub_email => $row, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return {
|
|
list_name => $info->{lst_title},
|
|
results => \@results,
|
|
invalid => $invalid,
|
|
duplicate => $duplicate,
|
|
hits => scalar @results,
|
|
successful => scalar @results - $invalid - $duplicate,
|
|
declined => $invalid + $duplicate
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB';
|
|
sub _check_subscriber {
|
|
#-----------------------------------------------------------------
|
|
#
|
|
my ($email, $lst_id, $db_stl, $wild_cards) = @_;
|
|
return GList::language('LST_IPT_OVERLIMIT') if (GList::check_limit('sublist', $lst_id));
|
|
return GList::language('LST_IPT_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ );
|
|
return GList::language('LST_IPT_ON_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('LST_IPT_ON_STOPLIST') if ($email =~ /$re/i);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_subscribers} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_subscribers {
|
|
#--------------------------------------------------------------------
|
|
# Print add form
|
|
#
|
|
my $do = shift || 0;
|
|
|
|
my $msg = ($do and $do =~ /^\d+$/) ? _sub_modify($do) : $do;
|
|
if ($do =~ /^\d+$/ and ($do =~ /3|4/ or ($do == 1 and $IN->param('unbounced_form')))) { # Reset bounced emails
|
|
return lst_unsub_bounced($msg);
|
|
}
|
|
return ('lst_subscriber_form.html') if ($IN->param('form'));
|
|
|
|
my $alpha;
|
|
my $cgi = $IN->get_hash();
|
|
my $hidden = GList::hidden;
|
|
|
|
# Create condition for subscriber's quick search bar
|
|
require GT::SQL::Condition;
|
|
my $cd = GT::SQL::Condition->new(lst_user_id_fk => '=' => $USER->{usr_username});
|
|
my $cols = $DB->table('Subscribers')->cols;
|
|
my $url = "glist.cgi?do=lst_subscribers$hidden->{hidden_query}";
|
|
my $query= '';
|
|
foreach my $c (keys % $cols) {
|
|
next if (!$cgi->{$c});
|
|
if ($c eq 'sub_list_id_fk') {
|
|
$cd->add($c => '=' => $cgi->{$c});
|
|
}
|
|
else {
|
|
$cd->add($c => 'like' => "%$cgi->{$c}%");
|
|
}
|
|
$url .= ";$c=$cgi->{$c}";
|
|
}
|
|
|
|
# Do a search from the main page
|
|
if ($IN->param('sub_search') and $IN->param('search_val')) {
|
|
$cgi->{$cgi->{search_col}} = $cgi->{search_val};
|
|
$url .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
|
|
$query .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
|
|
}
|
|
# And from quick search bar
|
|
if ($IN->param('alpha') and $IN->param('alpha') ne 'all') {
|
|
$alpha = $IN->param('alpha');
|
|
$query .= ";alpha=$alpha";
|
|
}
|
|
|
|
# Search on date fields
|
|
my $search_check = ($IN->param('search_form')) ? 1 : 0;
|
|
if ($cgi->{'sub_created-ge'} or $cgi->{'sub_created-le'}) {
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
my ($valid_from, $valid_to) = (1, 1);
|
|
|
|
require GT::Date;
|
|
if ($cgi->{'sub_created-ge'}) {
|
|
$valid_from = GList::date_to_time($cgi->{'sub_created-ge'}, $format);
|
|
$cgi->{'sub_created-ge'} = GT::Date::date_get($valid_from, $format) if ($valid_from);
|
|
}
|
|
if ($cgi->{'sub_created-le'}) {
|
|
$valid_to = GList::date_to_time($cgi->{'sub_created-le'}, $format);
|
|
$cgi->{'sub_created-le'} = GT::Date::date_get($valid_to, $format) if ($valid_to);
|
|
}
|
|
if ($search_check and (!$valid_from or !$valid_to)) {
|
|
$format =~ s/\%//g;
|
|
return ('lst_subscriber_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
|
|
}
|
|
}
|
|
if ($cgi->{sub_bounced}) {
|
|
$cgi->{'sub_bounced-opt'} = '>=';
|
|
}
|
|
my $results = GList::search(
|
|
cgi => $cgi,
|
|
db => $DB->table('Subscribers'),
|
|
prefix => 'sub',
|
|
sb => 'sub_email',
|
|
so => 'ASC',
|
|
search_alpha=> $alpha,
|
|
search_col => 'sub_email',
|
|
search_check=> $search_check,
|
|
show_user => $cgi->{show_user},
|
|
return_msg => 'LST_SUB_RESULTS',
|
|
);
|
|
|
|
my $page = ($IN->param('mn_disable')) ? 'lst_subscribers_preview.html' : 'lst_subscribers.html';
|
|
my $subs_db = $DB->table('Lists', 'Subscribers');
|
|
$subs_db->select_options('ORDER BY letter');
|
|
|
|
my $sth = $subs_db->select($cd, ['DISTINCT SUBSTRING(sub_email, 1, 1) as letter']);
|
|
if (ref $results ne 'HASH') {
|
|
$page = 'lst_subscriber_form.html' if ($search_check);
|
|
return ($page, { msg => $msg || $results, search_bar => _search_bar($sth, $url) });
|
|
}
|
|
elsif ($results->{error} and $search_check) {
|
|
return ('lst_subscriber_form.html', { msg => $results->{error} });
|
|
}
|
|
|
|
if ($IN->param('mn_disable')) {
|
|
$results->{msg} = '';
|
|
}
|
|
else {
|
|
$results->{msg} = $msg if ($msg);
|
|
}
|
|
return ($page, { search_bar => _search_bar($sth, $url), toolbar_query => $query, %$results });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_sub_modify} = __LINE__ . <<'END_OF_SUB';
|
|
sub _sub_modify {
|
|
#--------------------------------------------------------------------
|
|
# Validate/delete subscribers user
|
|
#
|
|
my $do = shift;
|
|
|
|
# If they selected only one record to search we still need an array ref
|
|
my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
|
|
my $db = $DB->table('Subscribers');
|
|
my $cgi = $IN->get_hash;
|
|
|
|
my ($msg, $rec_modified) = ('', 0);
|
|
if ($do == 1) { # Delete subscribers
|
|
foreach my $rec_num ( @{$mod} ) {
|
|
my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
|
|
next if (!$info);
|
|
|
|
my $ret = $db->delete({ sub_id => $info->{sub_id} });
|
|
if (defined $ret and $ret != 0) {
|
|
$rec_modified++;
|
|
}
|
|
}
|
|
$msg = GList::language('LST_SUB_DELETED', $rec_modified);
|
|
}
|
|
elsif ($do == 2) { # Validate subscribers
|
|
foreach my $rec_num ( @{$mod} ) {
|
|
my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
|
|
next if (!$info);
|
|
|
|
if ($db->count({ sub_id => $info->{sub_id}, sub_validated => 0 })) {
|
|
$db->update({ sub_validated => 1 }, { sub_id => $info->{sub_id} });
|
|
$rec_modified++;
|
|
}
|
|
}
|
|
$msg = GList::language('LST_SUB_VALIDATED', $rec_modified);
|
|
}
|
|
elsif ($do == 3) { # Unbounced subscribers
|
|
require GT::SQL::Condition;
|
|
foreach my $rec_num ( @{$mod} ) {
|
|
my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
|
|
next if (!$info);
|
|
|
|
if ($db->count(GT::SQL::Condition->new(sub_id => '=' => $info->{sub_id}, sub_bounced => '>=' => 1))) {
|
|
$db->update({ sub_bounced => '0' }, { sub_id => $info->{sub_id} });
|
|
$rec_modified++;
|
|
}
|
|
}
|
|
$msg = GList::language('LST_SUB_UNBOUNCED', $rec_modified);
|
|
}
|
|
elsif ($do == 4) { # Remove all unbounced subscribers
|
|
require GT::SQL::Condition;
|
|
my $cond = new GT::SQL::Condition;
|
|
$cond->add(sub_bounced => '>=' => 1, sub_user_id_fk => '=' => $USER->{usr_username});
|
|
$cond->add(sub_list_id_fk => '=', $cgi->{list_id}) if $cgi->{list_id};
|
|
if ($cgi->{sub_bounced} and $cgi->{sub_bounced} ne '*') {
|
|
my $opt = $cgi->{'sub_bounced-opt'} || '=';
|
|
$cond->add(sub_bounced => $opt => $cgi->{sub_bounced});
|
|
}
|
|
my $rec = $db->delete($cond);
|
|
$msg = GList::language('LST_BOUNCED_REMOVED', $rec);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_unsub_bounced} = __LINE__ . <<'END_OF_SUB';
|
|
sub lst_unsub_bounced {
|
|
#--------------------------------------------------------------------
|
|
# Let you to unsubscribe all bounced users
|
|
#
|
|
my $msg = shift;
|
|
|
|
my $cgi = $IN->get_hash();
|
|
my %hash;
|
|
my $conditions = '';
|
|
$hash{sub_list_id_fk} = $cgi->{sub_list_id_fk} || '';
|
|
$conditions .= ";list_id=$cgi->{sub_list_id_fk}" if $cgi->{sub_list_id_fk};
|
|
|
|
if ($cgi->{sub_bounced} and $cgi->{sub_bounced} eq '*') {
|
|
$conditions .= ';sub_bounced=*';
|
|
$hash{sub_bounced} = 1;
|
|
$hash{'sub_bounced-opt'} = '>=';
|
|
}
|
|
else {
|
|
$conditions .= ";sub_bounced=$cgi->{sub_bounced}";
|
|
$conditions .= ";sub_bounced-opt=$cgi->{'sub_bounced-opt'}";
|
|
if ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<') {
|
|
$hash{'sub_bounced-lt'} = $cgi->{sub_bounced};
|
|
$hash{'sub_bounced-ge'} = 1;
|
|
}
|
|
elsif ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<=') {
|
|
$hash{'sub_bounced-le'} = $cgi->{sub_bounced};
|
|
$hash{'sub_bounced-ge'} = 1;
|
|
}
|
|
else {
|
|
$hash{sub_bounced} = $cgi->{sub_bounced} || 1;
|
|
$hash{'sub_bounced-opt'} = $cgi->{'sub_bounced-opt'} || '>=';
|
|
}
|
|
}
|
|
my $results = GList::search(
|
|
cgi => \%hash,
|
|
db => $DB->table('Subscribers'),
|
|
prefix => 'sub',
|
|
sb => 'sub_email',
|
|
so => 'ASC',
|
|
return_msg => 'LST_BOUNCED_RESULTS',
|
|
int_field => 1,
|
|
);
|
|
if (ref $results ne 'HASH') {
|
|
return ('lst_unsub_bounced.html', { msg => $msg || $results });
|
|
}
|
|
|
|
$results->{msg} = $msg if ($msg);
|
|
return ('lst_unsub_bounced.html', { %$results, conditions => $conditions });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_sub_add} = <<'END_OF_SUB';
|
|
sub lst_sub_add {
|
|
#-------------------------------------------------------------------
|
|
# Add a subscriber
|
|
#
|
|
return ('lst_sub_add.html') if ($IN->param('form'));
|
|
return ('lst_sub_add.html', { msg => GList::language('LST_IPT_LIST_EMPTY') }) if (!$IN->param('import_to'));
|
|
|
|
my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
|
|
my $email = $IN->param('new_email');
|
|
my $name = $IN->param('new_name');
|
|
if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/) { # check email address
|
|
return ('lst_sub_add.html', { msg => GList::language('LST_IPT_INVALID_EMAIL') });
|
|
}
|
|
$email = lc $email;
|
|
|
|
# Create stoplist database and load wild cards
|
|
my $db = $DB->table('Subscribers');
|
|
my $db_stl = $DB->table('StopLists');
|
|
my $wild_cards = GList::wild_cards();
|
|
|
|
# Setup the language for GT::SQL.
|
|
local $GT::SQL::ERRORS->{UNIQUE} = GList::language('SYS_DUPLICATE');
|
|
local $GT::SQL::ERRORS->{NOTNULL} = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
|
|
local $GT::SQL::ERRORS->{ILLEGALVAL} = '';
|
|
|
|
my @results;
|
|
foreach my $id (@$import_to) {
|
|
my $info = GList::check_owner('Lists', 'lst', $id);
|
|
push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => lst_subscribers($info) } if ( ref $info ne 'HASH' );
|
|
|
|
push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => '' };
|
|
my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
|
|
if ($error) {
|
|
$results[-1]->{status} = $error;
|
|
}
|
|
elsif ($db->count({ sub_email => $email, sub_list_id_fk => $id })) {
|
|
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
|
}
|
|
else {
|
|
$db->insert({ sub_email => $email, sub_name => $name, sub_list_id_fk => $id, sub_user_id_fk => $info->{lst_user_id_fk} });
|
|
}
|
|
}
|
|
return ('lst_sub_success.html', { results => \@results, msg => GList::language('LST_SUB_ADDED', $email) });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_sub_modify} = <<'END_OF_SUB';
|
|
sub lst_sub_modify {
|
|
#-------------------------------------------------------------------
|
|
# Modify a subscriber
|
|
#
|
|
my $sub_id = $IN->param('subid');
|
|
my $old_data = $DB->table('Lists', 'Subscribers')->select({ sub_id => $sub_id }, [ 'lst_title', 'sub_email as new_email', 'sub_name as new_name', 'sub_validated as new_validated', 'sub_bounced as new_bounced', 'sub_list_id_fk'])->fetchrow_hashref;
|
|
return lst_subscribers(GList::language('LST_INVALID')) if (!$old_data);
|
|
|
|
my $info = GList::check_owner('Lists', 'lst', $old_data->{sub_list_id_fk});
|
|
return lst_subscribers($info) if (ref $info ne 'HASH');
|
|
|
|
return ('lst_sub_modify.html', $old_data) if ($IN->param('form'));
|
|
|
|
my $new_email = $IN->param('new_email');
|
|
my $name = $IN->param('new_name');
|
|
my $validated = ($IN->param('new_validated')) ? '1' : '0';
|
|
my $bounced = $IN->param('new_bounced') || 0;
|
|
|
|
if ($new_email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $new_email =~ /\s/) { # check email address
|
|
return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_INVALID_EMAIL'), %$info });
|
|
}
|
|
|
|
require GT::SQL::Condition;
|
|
if ($DB->table('Subscribers')->count( GT::SQL::Condition->new(
|
|
sub_email => '=' => $new_email,
|
|
sub_list_id_fk => '=' => $old_data->{sub_list_id_fk},
|
|
sub_id => '<>'=> $sub_id,
|
|
)) == 1 ) {
|
|
return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_DUPLICATE_EMAIL'), %$info });
|
|
}
|
|
else {
|
|
$DB->table('Subscribers')->update({
|
|
sub_email => $new_email,
|
|
sub_name => $name,
|
|
sub_validated => $validated,
|
|
sub_bounced => $bounced,
|
|
}, { sub_id => $sub_id });
|
|
}
|
|
return lst_subscribers(GList::language('LST_SUB_MODIFIED', $old_data->{new_email}));
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{lst_sub_delete} = <<'END_OF_SUB';
|
|
sub lst_sub_delete {
|
|
#-------------------------------------------------------------------
|
|
# Delete the subscribers
|
|
#
|
|
return lst_subscribers(1);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_sub_validate} = <<'END_OF_SUB';
|
|
sub lst_sub_validate {
|
|
#-------------------------------------------------------------------
|
|
# Validate the subscribers
|
|
#
|
|
return lst_subscribers(2);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{lst_sub_unbounced} = <<'END_OF_SUB';
|
|
sub lst_sub_unbounced {
|
|
#-------------------------------------------------------------------
|
|
# Validate the subscribers
|
|
#
|
|
my $action = $IN->param('all') ? 4 : 3;
|
|
return lst_subscribers($action);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_qsort} = __LINE__ . <<'END_OF_SUB';
|
|
sub _qsort {
|
|
#------------------------------------------------------------------
|
|
my ($list_file, $orderby, $sortdown) = @_;
|
|
my $sorted;
|
|
@$sorted =
|
|
sort {
|
|
my $da = lc $a->{$orderby}; #lower case
|
|
my $db = lc $b->{$orderby};
|
|
my $res;
|
|
if ($orderby eq 'size' or $orderby eq 'date') {
|
|
$res = $db <=> $da;
|
|
}
|
|
else {
|
|
$res = $db cmp $da;
|
|
}
|
|
if ($res == 0 and $orderby ne 'name') {
|
|
lc $b->{name} cmp lc $a->{name};
|
|
}
|
|
else {
|
|
$res;
|
|
}
|
|
} @$list_file;
|
|
($sortdown) and @$sorted = reverse @$sorted;
|
|
return $sorted;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_search_bar} = __LINE__ . <<'END_OF_SUB';
|
|
sub _search_bar {
|
|
#---------------------------------------------------------------------
|
|
# create quick search bar
|
|
#
|
|
my ($sth, $url) = @_;
|
|
my $current = $IN->param('alpha') || '';
|
|
my @alpha = ('All', 'A'..'Z', '0..9', 'Other');
|
|
|
|
my ($search_bar, $items);
|
|
$items->{All} = 'all';
|
|
while (my ($letter) = $sth->fetchrow_array) {
|
|
$letter = uc $letter;
|
|
if ($letter =~ /\d/) {
|
|
exists $items->{'0..9'} or $items->{'0..9'} = 'number';
|
|
}
|
|
elsif ($letter =~ /[\W_]/) {
|
|
exists $items->{Other} or $items->{Other} = 'other';
|
|
}
|
|
else {
|
|
exists $items->{$letter} or $items->{$letter} = $letter;
|
|
}
|
|
}
|
|
foreach (@alpha) {
|
|
if ($_ eq 'All') {
|
|
$search_bar .= ( (!$current or $current eq 'all') and !$IN->param('bsearch') ) ? "<b>$_</b> " : "<a href='$url&alpha=all'>$_</a> ";
|
|
}
|
|
elsif ($items->{$_}) {
|
|
my $l = ($_ eq '0..9') ? 'number' : lc $_;
|
|
$search_bar .= ( lc $current eq lc $l ) ? "<b>$_</b> " : "<a href='$url;alpha=$l'>$_</a> ";
|
|
}
|
|
else {
|
|
$search_bar .= "$_ ";
|
|
}
|
|
}
|
|
return $search_bar;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
|
sub _determine_action {
|
|
#----------------------------------------------------------------------------
|
|
# Check valid action
|
|
#
|
|
my $action = shift || undef;
|
|
return if (!$action);
|
|
return 'lst_home' if ($action eq 'lst_search' );
|
|
|
|
my %valid = (
|
|
map { $_ => 1 } qw(
|
|
lst_home
|
|
lst_add
|
|
lst_modify_form
|
|
lst_modify
|
|
lst_search_form
|
|
lst_delete
|
|
lst_html
|
|
lst_import
|
|
lst_subscribers
|
|
lst_sub_add
|
|
lst_sub_modify
|
|
lst_sub_delete
|
|
lst_sub_validate
|
|
lst_sub_unbounced
|
|
lst_unsub_bounced
|
|
)
|
|
);
|
|
exists $valid{$action} and return $action;
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
1;
|
|
|
|
|