1077 lines
42 KiB
Perl
1077 lines
42 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: Mailer.pm,v 1.79 2005/04/06 23:17:03 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::Mailer;
|
|
|
|
use strict;
|
|
use GList qw/:user_type :objects :tracks $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);
|
|
|
|
$MN_SELECTED = 3;
|
|
if ($tpl) {
|
|
my $hidden = GList::hidden();
|
|
$results->{hidden_query} = $hidden->{hidden_query};
|
|
$results->{hidden_objects} = $hidden->{hidden_objects};
|
|
GList::display($tpl, $results);
|
|
}
|
|
}
|
|
|
|
sub mli_print {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
my ($page, $args) = @_;
|
|
|
|
# Get category's information
|
|
my $nav = _load_navigator() || {};
|
|
my ($info, $url);
|
|
if ($IN->param('id')) {
|
|
$info = ( $USER->{usr_type} == ADMINISTRATOR ) ? $DB->table('CatMailing')->get({ cm_id => $IN->param('id') })
|
|
: $DB->table('CatMailing')->get({ cm_id => $IN->param('id'), cm_user_id_fk => $USER->{usr_username} });
|
|
}
|
|
$info ||= {};
|
|
|
|
# Create the URL
|
|
my @items = ('cd', 'cs', 'ca');
|
|
foreach (@items) {
|
|
$url .= "$_=".$IN->param($_).'&' if ($IN->param($_));
|
|
}
|
|
return ($page, { %$info, %$nav, %$args, url => $url });
|
|
}
|
|
|
|
$COMPILE{mli_home} = <<'END_OF_SUB';
|
|
sub mli_home {
|
|
#--------------------------------------------------------------------
|
|
# Print home page
|
|
#
|
|
my ($msg, $cgi) = @_;
|
|
|
|
$cgi ||= $IN->get_hash;
|
|
$msg ||= GList::language('MLI_SUCCESS', $cgi->{sent}) if ($cgi->{sent});
|
|
$msg = GList::language('MLI_BOUNCED_EMAILS', $cgi->{bounced}) if ($cgi->{bounced});
|
|
if ($cgi->{do} =~ /msg_send|mli_bounced/) {
|
|
$cgi->{fd} = 1;
|
|
}
|
|
|
|
#------------demo code-----------
|
|
|
|
if (!$cgi->{d}) {
|
|
if ( $cgi->{fd} and $cgi->{fd} =~ /^1|2/ ) { # Queue & Sent Items
|
|
$cgi->{mli_delete} = 1;
|
|
$cgi->{'mli_delete-opt'}= '<';
|
|
$cgi->{mli_done} = 1;
|
|
$cgi->{'mli_done-opt'} = ( $cgi->{fd} == 2 ) ? '>' : '<';
|
|
$cgi->{mli_scheduled} = 0;
|
|
if ( $cgi->{fd} == 2 and $cgi->{do} ne 'mli_search' ) {
|
|
$cgi->{mli_cat_id_fk} = ( $cgi->{id} ) ? $cgi->{id} : 0;
|
|
}
|
|
}
|
|
elsif ( $cgi->{fd} == 3 ) { # Delete Items
|
|
$cgi->{mli_delete} = 1;
|
|
}
|
|
elsif ($cgi->{fd} == 4) { # Scheduled mailings
|
|
$cgi->{mli_scheduled} = 1;
|
|
$cgi->{mli_delete} = 0;
|
|
}
|
|
}
|
|
my $search_check = ($IN->param('do') eq 'mli_search') ? 1 : 0;
|
|
if ($cgi->{'mli_done-ge'} or $cgi->{'mli_done-le'}) {
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
my ($valid_from, $valid_to) = (1, 1);
|
|
|
|
require GT::Date;
|
|
if ($cgi->{'mli_done-ge'}) {
|
|
$valid_from = GList::date_to_time($cgi->{'mli_done-ge'}, $format);
|
|
$cgi->{'mli_done-ge'} = GT::Date::date_get($valid_from, $format);
|
|
}
|
|
if ($cgi->{'mli_done-le'}) {
|
|
$valid_to = GList::date_to_time($cgi->{'mli_done-le'}, $format);
|
|
$cgi->{'mli_done-le'} = GT::Date::date_get($valid_to, $format);
|
|
}
|
|
|
|
if ($search_check and (!$valid_from or !$valid_to)) {
|
|
$format =~ s/\%//g;
|
|
return ('mli_search_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
|
|
}
|
|
}
|
|
if ($IN->param('do') eq 'mli_search' and $IN->param('fd') and $IN->param('fd') !~ /^1|2|3/) {
|
|
my @cat = split(/\-/, $IN->param('fd'));
|
|
$cgi->{mli_cat_id_fk} = $cat[1];
|
|
}
|
|
my $results = GList::search(
|
|
cgi => $cgi,
|
|
db => $DB->table('MailingIndex'),
|
|
prefix => 'mli',
|
|
sb => 'mli_id',
|
|
so => 'DESC',
|
|
search_check=> $search_check
|
|
);
|
|
# Get category's information
|
|
my $info = {};
|
|
if ($IN->param('id')) {
|
|
$info = ( $USER->{usr_type} == ADMINISTRATOR ) ? $DB->table('CatMailing')->get({ cm_id => $IN->param('id') })
|
|
: $DB->table('CatMailing')->get({ cm_id => $IN->param('id'), cm_user_id_fk => $USER->{usr_username} });
|
|
$info ||= {};
|
|
}
|
|
|
|
my $nav = _load_navigator() || {};
|
|
|
|
# Create the URL
|
|
my $url;
|
|
my @items = ('cd', 'cs', 'ca');
|
|
foreach ( @items ) {
|
|
$url .= "$_=".$cgi->{$_}.'&' if ( $cgi->{$_} );
|
|
}
|
|
chop $url if ($url);
|
|
|
|
if ( ref $results ne 'HASH' ) {
|
|
( $IN->param('do') eq 'mli_search' ) ? return ('mli_search_form.html', { msg => $msg || $results, %$nav, %$info, url => $url })
|
|
: return ('mli_home.html', { msg => $msg || $results, %$nav, %$info, url => $url });
|
|
}
|
|
elsif ( $results->{error} and $search_check ) {
|
|
return ('mli_search_form.html', { msg => $results->{error} });
|
|
}
|
|
|
|
my $eml = $DB->table('EmailMailings');
|
|
my $output = $results->{results};
|
|
|
|
require GT::SQL::Condition;
|
|
foreach my $rs ( @$output ) {
|
|
my $cd_sent = GT::SQL::Condition->new(
|
|
eml_mailing_id_fk => '=' => $rs->{mli_id},
|
|
eml_sent => '<>' => 0
|
|
);
|
|
$rs->{total} = $eml->count({ eml_mailing_id_fk => $rs->{mli_id} });
|
|
$rs->{bounced_emails} = $eml->count({ eml_mailing_id_fk => $rs->{mli_id}, eml_bounced => 1 });
|
|
$rs->{done} = $eml->count($cd_sent);
|
|
}
|
|
$results->{msg} = $msg if ($msg);
|
|
return ('mli_home.html', { %$results, %$nav, %$info, url => $url });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_search_form} = <<'END_OF_SUB';
|
|
sub mli_search_form {
|
|
#--------------------------------------------------------------------
|
|
# Print the search form
|
|
#
|
|
my $msg = shift;
|
|
return mli_print('mli_search_form.html', { msg => $msg });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_empty} = <<'END_OF_SUB';
|
|
sub mli_empty {
|
|
#--------------------------------------------------------------------
|
|
# Delete all of deleted items
|
|
#
|
|
require GT::SQL::Condition;
|
|
my $db = $DB->table('MailingIndex');
|
|
my $cd = new GT::SQL::Condition;
|
|
$cd->add('mli_delete', '=', 1);
|
|
|
|
if ($USER->{usr_type} == ADMINISTRATOR and $IN->param('users')) { # As a admin user
|
|
$cd->add('mli_user_id_fk', '<>', $USER->{usr_username});
|
|
}
|
|
else {
|
|
$cd->add('mli_user_id_fk', '=', $USER->{usr_username});
|
|
}
|
|
$db->delete($cd);
|
|
|
|
mli_home(GList::language('MLI_EMPTY'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_delete} = <<'END_OF_SUB';
|
|
sub mli_delete {
|
|
#--------------------------------------------------------------------
|
|
# Delete the mailings
|
|
#
|
|
return mli_home(GList::delete('MailingIndex', 'mli'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_move} = <<'END_OF_SUB';
|
|
sub mli_move {
|
|
#--------------------------------------------------------------------
|
|
# Moves the records to another category
|
|
#
|
|
( $IN->param('modify') ) or return mli_home(GList::language('SYS_MOVE_ERR'));
|
|
|
|
# Check category ID
|
|
my $to = $IN->param('move_to');
|
|
( $to) or return mli_home(GList::language('SYS_TARGET_ERR'));
|
|
|
|
if ( $to ne 'root' and $to ne 'draft' and $to ne 'sent') { # Move to a sub-category
|
|
my $info = GList::check_owner('CatMailing', 'cm', $to);
|
|
( ref $info eq 'HASH' ) or return mli_home($info);
|
|
}
|
|
|
|
# Need to know the number of records modified
|
|
my $rec_modified = 0;
|
|
my $rec_declined = 0;
|
|
|
|
my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
|
|
my $db = $DB->table('MailingIndex');
|
|
# For through the record numbers. These are the values of the check boxes
|
|
foreach my $rec_num ( @$mod ) {
|
|
my $change = {};
|
|
$change->{mli_id} = $IN->param("$rec_num-mli_id") if ($IN->param("$rec_num-mli_id"));
|
|
|
|
# Check if users can modify only their own records except Administrator
|
|
my $rs = $db->get($change);
|
|
if ( $USER->{usr_type} != ADMINISTRATOR ) {
|
|
next if ( !$rs );
|
|
if ( $rs->{'mli_user_id_fk'} ne $USER->{usr_username} ) {
|
|
$rec_declined++; next;
|
|
}
|
|
}
|
|
next unless ( keys %$change );
|
|
next if ($to eq 'draft' and $rs->{mli_done});
|
|
next if ($to eq 'sent' and !$rs->{mli_done});
|
|
|
|
my $ret;
|
|
if ( $to =~ /^root|draft|sent/mi ) {
|
|
$ret = ( $IN->param('fd') == 3 ) ? $db->update({ mli_cat_id_fk => 0, mli_delete => '0' }, $change)
|
|
: $db->update({ mli_cat_id_fk => 0 }, $change);
|
|
}
|
|
else {
|
|
$ret = $db->update({ mli_cat_id_fk => $to }, $change);
|
|
}
|
|
$rec_modified++ if (defined $ret and $ret != 0);
|
|
}
|
|
mli_home(($rec_declined) ? GList::language('SYS_MOVED2', $rec_modified, $rec_declined) : GList::language('SYS_MOVED', $rec_modified));
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{mli_send} = __LINE__ . <<'END_OF_SUB';
|
|
sub mli_send {
|
|
#--------------------------------------------------------------------
|
|
# Send Email - Send email to subcribers
|
|
#
|
|
return mli_home(GList::language('MLI_INVALID')) if (!$IN->param('modify'));
|
|
|
|
$MN_SELECTED = 3;
|
|
|
|
# Check account limits
|
|
my $num_sent = GList::check_limit('email30') || 0;
|
|
return mli_home(GList::language('SYS_OVERLIMIT_EMAIL30')) if ($num_sent == 1);
|
|
|
|
my $mod = (ref $IN->param('modify') eq 'ARRAY') ? $IN->param('modify') : [$IN->param('modify')];
|
|
my @ids = map $IN->param("$_-mli_id"), @{$mod};
|
|
|
|
my $total_size = _size_mailings(\@ids, 'web');
|
|
return mli_home(GList::language('MLI_MSG_EMPTY')) if (!$total_size);
|
|
|
|
_send('web', \@ids, $total_size);
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_fview} = <<'END_OF_SUB';
|
|
sub mli_fview {
|
|
#--------------------------------------------------------------------
|
|
# Print a attached file
|
|
#
|
|
return GList::view_file();
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_fdownload} = <<'END_OF_SUB';
|
|
sub mli_fdownload {
|
|
#--------------------------------------------------------------------
|
|
# Print a attached file
|
|
#
|
|
return GList::download_file();
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_bounced_form} = <<'END_OF_SUB';
|
|
sub mli_bounced_form {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
my ($msg, $page) = @_;
|
|
$page ||= 'mli_check_bounced_form.html';
|
|
$page = 'mli_check_bounced_results.html' if ($IN->param('results'));
|
|
|
|
return mli_print($page, { msg => $msg });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_bounced} = <<'END_OF_SUB';
|
|
sub mli_bounced {
|
|
#--------------------------------------------------------------------
|
|
# To check a pop account and delete bounced emails
|
|
#
|
|
|
|
#------------demo code-----------
|
|
|
|
return mli_bounced_form(GList::language('MLI_BOUNCED_NO_SERVER')) unless ($IN->param('mail_host'));
|
|
return mli_bounced_form(GList::language('MLI_BOUNCED_NO_USER')) unless ($IN->param('mail_user'));
|
|
return mli_bounced_form(GList::language('MLI_BOUNCED_NO_PASS')) unless ($IN->param('mail_pass'));
|
|
|
|
_bounced('web', {
|
|
host => $IN->param('mail_host'),
|
|
port => $IN->param('mail_port') || 110,
|
|
user => $IN->param('mail_user'),
|
|
pass => $IN->param('mail_pass'),
|
|
auth_mode => 'PASS',
|
|
debug => $CFG->{debug_level}
|
|
}, { delete => $IN->param('del_bounced'), save => $IN->param('save_info') });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_recipients} = <<'END_OF_SUB';
|
|
sub mli_recipients {
|
|
#-------------------------------------------------------------------
|
|
# View recipients
|
|
#
|
|
my $id = $IN->param('eml_mailing_id_fk');
|
|
return mli_home(GList::language('MLI_INVALID')) if (!$id);
|
|
|
|
# Check the record's onwer
|
|
my $mli = $DB->table('MailingIndex')->get($id);
|
|
return mli_home(GList::language('MLI_NOT_FOUND', $id)) if (!$mli);
|
|
|
|
if ( $USER->{usr_type} != ADMINISTRATOR ) { # As a user
|
|
my $cond = new GT::SQL::Condition('OR');
|
|
|
|
$cond->add('usr_username', '=', $mli->{mli_user_id_fk});
|
|
my $u = $DB->table('Users')->select($cond)->rows;
|
|
return mli_home(GList::language('SYS_PER_DENIED')) if (!$u);
|
|
}
|
|
|
|
my $cgi = $IN->get_hash;
|
|
$cgi->{eml_mailing_id_fk} = $id;
|
|
my $results = GList::search(
|
|
cgi => $cgi,
|
|
db => $DB->table('EmailMailings'),
|
|
skip_user => 1,
|
|
prefix => 'eml',
|
|
sb => 'eml_email',
|
|
so => 'ASC',
|
|
);
|
|
|
|
if ( ref $results ne 'HASH' ) {
|
|
return ('mli_recipients.html', %$results);
|
|
}
|
|
return ('mli_recipients.html', $results);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_cat_add} = <<'END_OF_SUB';
|
|
sub mli_cat_add {
|
|
#--------------------------------------------------------------------
|
|
# Add a category
|
|
#
|
|
my $name = $IN->param('cm_name');
|
|
( $name ) or return mli_home(GList::language('SYS_ADD_INVALID'));
|
|
|
|
my $ret = GList::add('CatMailing', 'cm', { cm_name => $name, cm_type => 2 });
|
|
return mli_home($GList::error) if ($GList::error);
|
|
|
|
return mli_home(GList::language('DIR_ADDED', $name)) if ( $ret );
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_cat_modify} = <<'END_OF_SUB';
|
|
sub mli_cat_modify {
|
|
#-------------------------------------------------------------------
|
|
# Update a category
|
|
#
|
|
my $id = $IN->param('cm_id');
|
|
( $id ) or return mli_home(GList::languag('SYS_ADD_INVALID'));
|
|
|
|
GList::modify('CatMailing', 'cm');
|
|
|
|
return mli_home($GList::error) if ($GList::error);
|
|
mli_home(GList::language('DIR_UPDATED', $IN->param('cm_name')));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_cat_delete} = <<'END_OF_SUB';
|
|
sub mli_cat_delete {
|
|
#--------------------------------------------------------------------
|
|
# Delete a category
|
|
#
|
|
my $cgi = $IN->get_hash();
|
|
|
|
( $cgi->{cm_id}) or return mli_home(GList::languag('SYS_ADD_INVALID'));
|
|
|
|
$cgi->{modify} = '1';
|
|
$cgi->{'1-cm_id'} = $cgi->{cm_id};
|
|
if ( $USER->{usr_type} != ADMINISTRATOR ) {
|
|
my $owner = $DB->table('CatMailing')->select({ cm_user_id_fk => $USER->{usr_username} }, ['cm_user_id_fk'])->fetchrow_array;
|
|
( !$owner or $owner ne $USER->{usr_username} ) and return mli_home(GList::language('SYS_PER_DENIED'));
|
|
}
|
|
|
|
$DB->table('MailingIndex')->update({ mli_cat_id_fk => 0, mli_delete => '1' }, { mli_cat_id_fk => $cgi->{cm_id} });
|
|
|
|
return mli_home(GList::delete('CatMailing', 'cm', $cgi, GList::language('DIR_DELETED', $IN->param('cm_name'))));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_schedule} = __LINE__ . <<'END_OF_SUB';
|
|
sub mli_schedule {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
return mli_home() if $IN->param('bcancel');
|
|
|
|
my $mod = ref $IN->param('modify') eq 'ARRAY' ? $IN->param('modify') : [$IN->param('modify')];
|
|
my @ids = map $IN->param("$_-mli_id"), @{$mod};
|
|
|
|
require GT::SQL::Condition;
|
|
my $results = $DB->table('MailingIndex')->select(['mli_id', 'mli_subject'], GT::SQL::Condition->new(mli_id => 'IN' => \@ids))->fetchall_hashref;
|
|
return mli_home('0 mailing was scheduled') unless $results;
|
|
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MSG'), selected_mailings => $results }) unless $IN->param('bschedule');
|
|
|
|
my $scm_type = $IN->param('scm_type');
|
|
my $minute = $IN->param('scm_minute') || 0;
|
|
my $hour = $IN->param('scm_hour') || 0;
|
|
my $text_url = $IN->param('scm_text_url') || '';
|
|
my $html_url = $IN->param('scm_html_url') || '';
|
|
my $option = '';
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_TYPE'), selected_mailings => $results }) unless $scm_type;
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), selected_mailings => $results }) if ($text_url and $text_url !~ /^http/);
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), selected_mailings => $results }) if ($html_url and $html_url !~ /^http/);
|
|
|
|
if ($scm_type == 1) {
|
|
my $opt_date = $IN->param('opt_date');
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), selected_mailings => $results }) unless $opt_date;
|
|
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
my $valid = GList::date_to_time($opt_date, $format);
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')), selected_mailings => $results }) unless $valid;
|
|
|
|
$option = $valid;
|
|
}
|
|
elsif ($scm_type == 3) {
|
|
my $opt_weekly = $IN->param('opt_weekly');
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), selected_mailings => $results }) unless $opt_weekly;
|
|
$option = $opt_weekly;
|
|
}
|
|
elsif ($scm_type == 4) {
|
|
my $opt_monthly = $IN->param('opt_monthly');
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), selected_mailings => $results }) unless $opt_monthly;
|
|
$option = $opt_monthly;
|
|
}
|
|
|
|
my @scheduleds;
|
|
my $db = $DB->table('ScheduledMailings');
|
|
foreach my $m (@$results) {
|
|
$db->insert({ scm_mailing_id_fk => $m->{mli_id}, scm_hour => $hour, scm_minute => $minute, scm_type => $scm_type, scm_option => $option, scm_text_url => $text_url, scm_html_url => $html_url }) or next;
|
|
push @scheduleds, $m->{mli_id};
|
|
}
|
|
$DB->table('MailingIndex')->update({ mli_done => 0, mli_scheduled => 1}, GT::SQL::Condition->new( mli_id => 'IN' => \@scheduleds ));
|
|
mli_home(GList::language('MLI_SCHEDULES_CREATED', $#scheduleds + 1));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_schedule_modify} = __LINE__ . <<'END_OF_SUB';
|
|
sub mli_schedule_modify {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
my $msg = '';
|
|
my $mli_id = $IN->param('mli_id');
|
|
my $cgi = $IN->get_hash();
|
|
delete $cgi->{mli_id};
|
|
|
|
return mli_home(GList::language('MLI_MISSING_ID')) unless $mli_id;
|
|
return mli_home($msg, $cgi) if $IN->param('bcancel');
|
|
|
|
my $schedule = $DB->table('ScheduledMailings', 'MailingIndex')->select(['ScheduledMailings.*', 'MailingIndex.mli_subject'], { scm_mailing_id_fk => $mli_id })->fetchrow_hashref;
|
|
return mli_home("<b>$mli_id</b> not found!") unless $schedule;
|
|
|
|
if ($IN->param('mod_action') and $IN->param('mod_action') eq 'delete') {
|
|
return mli_schedule_delete($mli_id);
|
|
}
|
|
elsif ($IN->param('bmodify')) {
|
|
my $scm_type = $IN->param('scm_type');
|
|
my $minute = $IN->param('scm_minute') || 0;
|
|
my $hour = $IN->param('scm_hour') || 0;
|
|
my $text_url = $IN->param('scm_text_url') || '';
|
|
my $html_url = $IN->param('scm_html_url') || '';
|
|
my $option = '';
|
|
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), %$schedule }) if ($text_url and $text_url !~ /^http/);
|
|
return mli_print('mli_schedule_mailing.html', { msg => GList::language('MLI_INVALID_URL'), %$schedule }) if ($html_url and $html_url !~ /^http/);
|
|
|
|
if ($scm_type == 1) {
|
|
my $opt_date = $IN->param('opt_date');
|
|
return mli_print('mli_modify_schedule.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), scm_type => 1, %$schedule }) unless $opt_date;
|
|
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
my $valid = GList::date_to_time($opt_date, $format);
|
|
return mli_print('mli_modify_schedule.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')), %$schedule }) unless $valid;
|
|
|
|
$option = $valid;
|
|
}
|
|
elsif ($scm_type == 3) {
|
|
my $opt_weekly = $IN->param('opt_weekly');
|
|
return mli_print('mli_modify_schedule.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), scm_type => 3, %$schedule }) unless $opt_weekly;
|
|
$option = $opt_weekly;
|
|
}
|
|
elsif ($scm_type == 4) {
|
|
my $opt_monthly = $IN->param('opt_monthly');
|
|
return mli_print('mli_modify_schedule.html', { msg => GList::language('MLI_SCHEDULE_MISSING_OPT'), scm_type => 4, %$schedule }) unless $opt_monthly;
|
|
$option = $opt_monthly;
|
|
}
|
|
$DB->table('ScheduledMailings')->update({ scm_hour => $hour, scm_minute => $minute, scm_type => $scm_type, scm_inprocess => 0, scm_sent => 0, scm_option => $option, scm_text_url => $text_url, scm_html_url => $html_url }, { scm_mailing_id_fk => $mli_id });
|
|
return mli_home(GList::language('MLI_SCHEDULE_UPDATED', $mli_id), $cgi);
|
|
}
|
|
|
|
my ($opt_monthly, $opt_weekly, $opt_date);
|
|
if ($schedule->{scm_type} == 1) {
|
|
require GT::Date;
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
$opt_date = GT::Date::date_get($schedule->{scm_option}, $format);
|
|
}
|
|
elsif ($schedule->{scm_type} == 3) {
|
|
$opt_weekly = $schedule->{scm_option};
|
|
}
|
|
elsif ($schedule->{scm_type} == 4) {
|
|
$opt_monthly = $schedule->{scm_option};
|
|
}
|
|
return mli_print('mli_modify_schedule.html', { msg => $msg, opt_date => $opt_date, opt_weekly => $opt_weekly, opt_monthly => $opt_monthly, %$schedule });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{mli_schedule_delete} = __LINE__ . <<'END_OF_SUB';
|
|
sub mli_schedule_delete {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
my $mli_id = shift;
|
|
|
|
my @ids;
|
|
my $cgi = $IN->get_hash();
|
|
delete $cgi->{mli_id};
|
|
if ($mli_id) {
|
|
push @ids, $mli_id;
|
|
}
|
|
else {
|
|
my $mod = ref $IN->param('modify') eq 'ARRAY' ? $IN->param('modify') : [$IN->param('modify')];
|
|
@ids = map $IN->param("$_-mli_id"), @{$mod};
|
|
}
|
|
foreach my $id (@ids) {
|
|
$DB->table('ScheduledMailings')->delete({ scm_mailing_id_fk => $id });
|
|
$DB->table('MailingIndex')->update({ mli_scheduled => 0 }, { mli_id => $id });
|
|
}
|
|
my $msg = $mli_id ? GList::language('MLI_SCHEDULE_DELETED', $mli_id) : GList::language('MLI_SCHEDULES_DELETED', $#ids + 1);
|
|
return mli_home($msg, $cgi);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_print_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub _print_results {
|
|
my ($call_from, $checkeds, $bounceds, $deleteds) = @_;
|
|
if ($call_from eq 'web') {
|
|
mli_bounced_form(undef, 'mli_check_bounced_results.html');
|
|
}
|
|
else {
|
|
print qq!\n
|
|
- Total checked email(s): $checkeds
|
|
- Total bounced email(s): $bounceds
|
|
- Total deleted email(s): $deleteds
|
|
!;
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_bounced} = __LINE__ . <<'END_OF_SUB';
|
|
sub _bounced {
|
|
#-------------------------------------------------------------------
|
|
#
|
|
my ($call_from, $connection, $opts) = @_;
|
|
|
|
require GT::Mail::POP3;
|
|
my $pop = new GT::Mail::POP3 ($connection);
|
|
my $num_emails = $pop->connect;
|
|
if ($GT::Mail::POP3::error) {
|
|
($call_from eq 'web') ? return mli_bounced_form("<font color=red>$GT::Mail::POP3::error</font>")
|
|
: die "$GT::Mail::POP3::error";
|
|
}
|
|
if ($call_from eq 'web' and $opts->{save}) { # Save connection to users' profile
|
|
$DB->table('Users')->update({
|
|
usr_mail_host => $connection->{host},
|
|
usr_mail_port => $connection->{port} || 110,
|
|
usr_mail_account => $connection->{user},
|
|
usr_mail_password => $connection->{pass},
|
|
}, { usr_username => $USER->{usr_username} }
|
|
);
|
|
}
|
|
if ($num_emails == 0) {
|
|
$pop->quit;
|
|
return _print_results($call_from, 0, 0);
|
|
}
|
|
elsif ($call_from eq 'web' and $num_emails > $CFG->{max_bounced_emails}) {
|
|
$pop->quit;
|
|
return mli_bounced_form(GList::language('MLI_OVERLIMIT_BOUNCEDS'));
|
|
}
|
|
|
|
my $db_sub = $DB->table('Subscribers');
|
|
my $db_eml = $DB->table('EmailMailings');
|
|
|
|
# handle the progress bar
|
|
my ($last_width, $checked, $bounced, $deleted) = (0, 0, 0, 0);
|
|
my ($prog_header, $prog_footer) = '';
|
|
my $max_width = ($call_from eq 'web') ? 420 : 50;
|
|
if ($call_from eq 'web') {
|
|
GList::display('mli_progress_bar.html');
|
|
$prog_header = "<script>msg.innerHTML = '".GList::language('MLI_CHECK_BOUNCED')."'</script>";
|
|
}
|
|
else {
|
|
$prog_header = "";
|
|
$prog_footer = "Done";
|
|
}
|
|
|
|
print $prog_header;
|
|
foreach ( 1..$num_emails ) {
|
|
$checked++;
|
|
my $content = $pop->retr($_);
|
|
if ($$content =~ /x-glist:\s+(\w+)/i) {
|
|
my $code = $1;
|
|
my $info = $db_eml->get({ eml_code => $code });
|
|
if ($info) {
|
|
$db_sub->update({ sub_bounced => \'sub_bounced + 1' }, { sub_email => $info->{eml_email} });
|
|
$db_eml->update({ eml_bounced => 1 }, { eml_email => $info->{eml_email}, eml_code => $code });
|
|
$bounced++;
|
|
if ($opts->{delete} =~ /1|2/) {
|
|
if ($pop->dele($_)) {
|
|
$deleted++;
|
|
}
|
|
else {
|
|
warn "Can't delete email $_: $GT::Mail::POP3::error";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
elsif ($opts->{delete} == 2) { # delete all option is set.
|
|
if ($pop->dele($_)) {
|
|
$deleted++;
|
|
}
|
|
else {
|
|
warn "Can't delete email $_: $GT::Mail::POP3::error";
|
|
}
|
|
}
|
|
my $wpercent = 1 - ($num_emails - $checked) / $num_emails;
|
|
my $img_width= int($max_width * $wpercent);
|
|
if ($img_width != $last_width) {
|
|
if ($call_from eq 'web') {
|
|
printf "<script>img.width = $img_width; per.innerHTML = '%.f%%'</script>\n", 100 * $wpercent;
|
|
}
|
|
else {
|
|
_print_dot($img_width - $last_width);
|
|
}
|
|
$last_width = $img_width;
|
|
}
|
|
}
|
|
$pop->quit;
|
|
|
|
if ($call_from eq 'web') {
|
|
my $url = ($USER->{use_cookie}) ? "$CFG->{cgi_url}/glist.cgi?do=mli_bounced_form;parsed=$num_emails;bounced=$bounced;deleted=$deleted;results=1"
|
|
: "$CFG->{cgi_url}/glist.cgi?do=mli_bounced_form;parsed=$num_emails;bounced=$bounced;deleted=$deleted;results=1;sid=$USER->{session_id}";
|
|
print "<script>window.location = '$url'</script>";
|
|
}
|
|
else {
|
|
print $prog_footer;
|
|
_print_results($call_from, $num_emails, $bounced, $deleted);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_send} = __LINE__ . <<'END_OF_SUB';
|
|
sub _send {
|
|
#---------------------------------------------------------------------
|
|
# This subsroutine will be called from either web or shell mode
|
|
#
|
|
my ($call_from, $ids, $total_size) = @_;
|
|
|
|
require GList::Template;
|
|
require GT::TempFile;
|
|
|
|
my $demo = 0;
|
|
#------------demo code-----------
|
|
|
|
if ($call_from eq 'web') {
|
|
GList::display('mli_progress_bar.html');
|
|
print "<script>msg.innerHTML = '".GList::language('MSG_CHECKING')."'</script>";
|
|
}
|
|
|
|
my $start = time();
|
|
my $started = scalar localtime;
|
|
my $db_mli = $DB->table('MailingIndex');
|
|
my $db_eml = $DB->table('EmailMailings');
|
|
my $db_mat = $DB->table('MailingAttachments');
|
|
my $db_sub = $DB->table('Subscribers');
|
|
my $db_usr = $DB->table('Users');
|
|
my $sub_cols = $DB->table('Subscribers')->cols;
|
|
my $usr_cols = $DB->table('Users')->cols;
|
|
my $num_sent = ($call_from eq 'web') ? (GList::check_limit('email30') || 0) : 0;
|
|
my $data = $USER || {};
|
|
$data->{cgi_url} = $CFG->{cgi_url};
|
|
$data->{image_url} = $CFG->{image_url};
|
|
|
|
|
|
# Load StopLists
|
|
my $stoplist = $DB->table('StopLists')->select(['stl_email'])->fetchall_arrayref;
|
|
my %stoplist;
|
|
foreach (@$stoplist) {
|
|
next if (!$_->[0]);
|
|
exists $stoplist{$_->[0]} or $stoplist{$_->[0]} = 1;
|
|
}
|
|
|
|
$|++;
|
|
my ($count, $sent_size, $last_width) = (0, 0, -1);
|
|
my ($html_header, $html_footer, $text_header, $text_footer, $prog_header, $prog_footer);
|
|
my $max_width = ($call_from eq 'web') ? 420 : 50;
|
|
my $temp_text = new GT::TempFile;
|
|
my $temp_html = new GT::TempFile;
|
|
if ($call_from eq 'web') {
|
|
$prog_header = "<script>msg.innerHTML = '".GList::language('MSG_SENDING')."'</script>";
|
|
my $url = ($USER->{use_cookie}) ? "$CFG->{cgi_url}/glist.cgi?do=mli_home;fd=2;sent=$count;demo=$demo"
|
|
: "$CFG->{cgi_url}/glist.cgi?do=mli_home;fd=2;sent=$count;sid=$USER->{session_id};demo=$demo";
|
|
$prog_footer = "<script>window.location = '$url'</script>";
|
|
|
|
# Set header and footer if they are specified
|
|
$html_header = ($CFG->{header_html}) ? "$CFG->{header_html}<BR>$USER->{usr_header_html}" : $USER->{usr_header_html};
|
|
$html_footer = ($CFG->{footer_html}) ? "$USER->{usr_footer_html}<BR>$CFG->{footer_html}" : $USER->{usr_footer_html};
|
|
$text_header = ($CFG->{header_text}) ? "$CFG->{header_text}\n$USER->{usr_header_text}" : $USER->{usr_header_text};
|
|
$text_footer = ($CFG->{footer_text}) ? "$USER->{usr_footer_text}\n$CFG->{footer_text}" : $USER->{usr_footer_text};
|
|
}
|
|
else {
|
|
$prog_header = "\nSending messages\n";
|
|
$prog_footer = "Done\n";
|
|
}
|
|
|
|
print $prog_header;
|
|
foreach my $mailing (@$ids) {
|
|
my ($msg_size, $att_size, $info) = (0, 0, {});
|
|
|
|
if ($call_from eq 'web') {
|
|
last if ($USER->{usr_type} == LIMITED_USER and $num_sent >= $USER->{usr_limit_email30});
|
|
$info = GList::check_owner('MailingIndex', 'mli', $mailing);
|
|
}
|
|
else {
|
|
$info = $db_mli->get($mailing);
|
|
my $user = $db_usr->get({ usr_username => $info->{mli_user_id_fk}});
|
|
if ($user) {
|
|
$data = $user;
|
|
$html_header = ($CFG->{header_html}) ? "$CFG->{header_html}<BR>$user->{usr_header_html}" : $user->{usr_header_html};
|
|
$html_footer = ($CFG->{footer_html}) ? "$user->{usr_footer_html}<BR>$CFG->{footer_html}" : $user->{usr_footer_html};
|
|
$text_header = ($CFG->{header_text}) ? "$CFG->{header_text}\n$user->{usr_header_text}" : $user->{usr_header_text};
|
|
$text_footer = ($CFG->{footer_text}) ? "$user->{usr_footer_text}\n$CFG->{footer_text}" : $user->{usr_footer_text};
|
|
}
|
|
}
|
|
next if (!$info or ref $info ne 'HASH');
|
|
next if ($info->{mli_done}); # Skip if it has already been sent
|
|
|
|
$count++;
|
|
my $mailings = $db_eml->select({ eml_mailing_id_fk => $mailing, eml_sent => 0 })->fetchall_hashref;
|
|
my $attachs = $db_mat->select({ mat_mailing_id_fk => $mailing })->fetchall_hashref;
|
|
|
|
# Figure out the attachments size
|
|
foreach (@$attachs) {
|
|
$att_size += -s "$CFG->{priv_path}/attachments/mailings/" . ($mailing % 10) . "/$mailing/$_->{mat_id}";
|
|
}
|
|
|
|
# Figure out the message size
|
|
my $content_text = $info->{mli_message_text};
|
|
my $content_html = $info->{mli_message_html};
|
|
$msg_size = length $content_html if ($content_html);
|
|
$msg_size += length $content_text if ($content_text);
|
|
|
|
# Add header and footer if they are available
|
|
$content_text = "$text_header\n$content_text" if ($content_text and $text_header);
|
|
$content_text .= "\n$text_footer" if ($content_text and $text_footer);
|
|
$content_html = "$html_header<BR>$content_html" if ($content_html and $html_header);
|
|
$content_html .= "<BR>$html_footer" if ($content_html and $html_footer);
|
|
|
|
open (TEXT, "> $$temp_text");
|
|
print TEXT $content_text;
|
|
close TEXT;
|
|
|
|
if ($info->{mli_message_html}) {
|
|
$content_html =~ s/<%/<%/g;
|
|
$content_html =~ s/%>/%>/g;
|
|
if ($info->{mli_track_open}) { # Insert track openning code
|
|
$content_html.= ($CFG->{iframe_tracking}) ? TRACK_OPEN_HTML : TRACK_OPEN_HTML_NOIFRAME;
|
|
}
|
|
$content_html = _replace_url($content_html, TRACK_CLICK_URL) if ($info->{mli_track_click});
|
|
open (HTML, "> $$temp_html");
|
|
print HTML $content_html;
|
|
close HTML;
|
|
}
|
|
foreach my $m (@$mailings) {
|
|
last if ($call_from eq 'web' and $USER->{usr_type} == LIMITED_USER and $num_sent >= $USER->{usr_limit_email30});
|
|
next unless $db_eml->count( eml_id => $m->{eml_id}, eml_sent => '0' );
|
|
|
|
if ( exists $stoplist{$m->{eml_email}} ) { # skip email if it's in stoplist
|
|
$db_eml->update({ eml_skipped => '1', eml_sent => time }, { eml_id => $m->{eml_id} });
|
|
next;
|
|
}
|
|
|
|
my $bounce_code = _generate_bounce_code();
|
|
my $sth = $db_eml->update({ eml_sent => time, eml_code => $bounce_code }, { eml_id => $m->{eml_id}, eml_sent => 0 })
|
|
or next;
|
|
my $rows = $sth->rows;
|
|
next unless $rows;
|
|
|
|
# Allows personalizing of messages using <%...%> tags
|
|
my $lists = join ';', map "lid=$_", split ',', $m->{eml_lists};
|
|
$data->{mailing} = $info->{mli_id};
|
|
$data->{eml_code}= $bounce_code;
|
|
$data->{unsubscribe_url} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists")
|
|
: "$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists";
|
|
|
|
#--------------------------
|
|
# LJM: Parse out arbitrary lists - keys will replace these
|
|
#--------------------------
|
|
$lists = "lid=";
|
|
$data->{unsubscribe_list} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists")
|
|
: "$CFG->{cgi_url}/glist.cgi?do=user_rm;eml_code=$bounce_code;$lists";
|
|
$data->{subscribe_list} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_subscribe;eml_code=$bounce_code;$lists")
|
|
: "$CFG->{cgi_url}/glist.cgi?do=user_subscribe;eml_code=$bounce_code;$lists";
|
|
$lists = "from_to_lid=";
|
|
$data->{move_list} = ($info->{mli_track_click}) ? "$CFG->{cgi_url}/glist.cgi?do=user_click;mailing=$info->{mli_id};url=".$IN->escape("$CFG->{cgi_url}/glist.cgi?do=user_move;eml_code=$bounce_code;$lists")
|
|
: "$CFG->{cgi_url}/glist.cgi?do=user_move;eml_code=$bounce_code;$lists";
|
|
#--------------------------
|
|
|
|
foreach ( keys %$sub_cols ) { # Subscriber's information
|
|
(my $c = $_) =~ s/sub/eml/;
|
|
$data->{$_} = $m->{$c};
|
|
}
|
|
|
|
my $text = $content_text;
|
|
my $html = $content_html;
|
|
my $key = join '|', map quotemeta, keys %$data;
|
|
|
|
$text =~ s/<%($key)%>/$data->{$1}/g;
|
|
$html =~ s/<%($key)%>/$data->{$1}/g;
|
|
|
|
$text = GList::Template->parse($$temp_text, $data, { disable => { functions => 1 } }) if ($text =~ /<%/);
|
|
$html = GList::Template->parse($$temp_html, $data, { disable => { functions => 1 } }) if ($html and $html =~ /<%/);
|
|
|
|
my %head;
|
|
my $to_quoted = "$m->{eml_name} ";
|
|
my $from_quoted = "$info->{mli_name} ";
|
|
if ($to_quoted =~ /[^\w\s]/) {
|
|
$to_quoted =~ s/([\\"])/\\$1/g;
|
|
$to_quoted = '"' . substr($to_quoted, 0, -1) . '" ';
|
|
}
|
|
if ($from_quoted =~ /[^\w\s]/) {
|
|
$from_quoted =~ s/([\\"])/\\$1/g;
|
|
$from_quoted = '"' . substr($from_quoted, 0, -1) . '" ';
|
|
}
|
|
$head{from} = $info->{mli_name} ? $from_quoted . "<$info->{mli_from}>" : $info->{mli_from};
|
|
$head{to} = $m->{eml_name} ? $to_quoted . "<$m->{eml_email}>" : $m->{eml_email};
|
|
$head{subject} = $info->{mli_subject};
|
|
$head{'Reply-To'} = $info->{mli_reply_to};
|
|
$head{'Return-Path'}= $info->{mli_bounce_email};
|
|
$head{'X-GList'} = $bounce_code;
|
|
|
|
# Handle the progress bar
|
|
$sent_size += $msg_size + $att_size;
|
|
my $wpercent = 1 - ($total_size - $sent_size) / $total_size;
|
|
my $img_width = int($max_width * $wpercent);
|
|
|
|
if (!$demo) {
|
|
GList::send(\%head, { text => $text, html => $html }, $attachs, "$CFG->{priv_path}/attachments/mailings/" . ($mailing % 10) . "/$mailing", $info->{mli_charset});
|
|
}
|
|
$num_sent++;
|
|
|
|
if ( $img_width != $last_width ) {
|
|
if ($call_from eq 'web') {
|
|
printf "<script>img.width = $img_width; per.innerHTML = '%.f%%'</script>\n", 100 * $wpercent;
|
|
}
|
|
else {
|
|
_print_dot($img_width - $last_width);
|
|
}
|
|
$last_width = $img_width;
|
|
}
|
|
}
|
|
if (!$db_eml->count({ eml_mailing_id_fk => $mailing, eml_sent => 0 })) {
|
|
$db_mli->update({ mli_done => time, mli_cat_id_fk => 0 }, { mli_id => $mailing });
|
|
}
|
|
}
|
|
print $prog_footer;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_size_mailings} = __LINE__ . <<'END_OF_SUB';
|
|
sub _size_mailings {
|
|
#--------------------------------------------------------------------
|
|
# Get the size of mailings
|
|
#
|
|
my ($ids, $call_from) = @_;
|
|
|
|
my $db_attach = $DB->table('MailingAttachments');
|
|
my $db_email = $DB->table('EmailMailings');
|
|
my $db_mailing= $DB->table('MailingIndex');
|
|
my $size = 0;
|
|
foreach my $mailing ( @$ids ) {
|
|
my $length = 0;
|
|
my $info;
|
|
|
|
# Check who owns it
|
|
if ($call_from eq 'web') {
|
|
$info = GList::check_owner('MailingIndex', 'mli', $mailing);
|
|
next if (ref $info ne 'HASH');
|
|
}
|
|
else {
|
|
$info = $db_mailing->get($mailing);
|
|
next if (!$info);
|
|
}
|
|
|
|
# Skip if it's been completed
|
|
next if ( $info->{mli_done} );
|
|
|
|
# Of Text and HTML message
|
|
$length += length $info->{mli_message_text} if ($info->{mli_message_text});
|
|
$length += length $info->{mli_message_html} if ($info->{mli_message_html});
|
|
|
|
# Get the size of attachments
|
|
my $attach = $db_attach->select({ mat_mailing_id_fk => $mailing });
|
|
|
|
while ( my $rs = $attach->fetchrow_hashref ) {
|
|
$length += -s "$CFG->{priv_path}/attachments/mailings/" . ($mailing % 10) . "/$mailing/$rs->{mat_id}";
|
|
}
|
|
|
|
my $emails = $db_email->count({ eml_mailing_id_fk => $mailing, eml_sent => '0' });
|
|
$length *= $emails if ( $emails );
|
|
$size += $length;
|
|
}
|
|
return $size;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_load_navigator} = __LINE__ . <<'END_OF_SUB';
|
|
sub _load_navigator {
|
|
#---------------------------------------------------------------------
|
|
# Generates Category listings
|
|
#
|
|
my $user = GList::load_condition();
|
|
|
|
my $db = $DB->table('CatMailing', 'MailingIndex');
|
|
my $cond = GT::SQL::Condition->new('cm_user_id_fk', $user->{opt}, $user->{id});
|
|
$db->select_options('GROUP BY cm_type,cm_id, cm_name ORDER BY cm_name');
|
|
|
|
my $sth = $db->select('left_join', $cond, ['CatMailing.cm_id', 'CatMailing.cm_type', 'CatMailing.cm_name', 'count(mli_id) as mailing']) or die "$GT::SQL::error";
|
|
my ($draft, $sent);
|
|
while ( my $rs = $sth->fetchrow_hashref ) {
|
|
if ( $rs->{cm_type} eq '1' ) {
|
|
push @$draft, $rs;
|
|
}
|
|
else {
|
|
push @$sent, $rs;
|
|
}
|
|
}
|
|
|
|
my $db_mli = $DB->table('MailingIndex');
|
|
my $cd = GT::SQL::Condition->new(
|
|
mli_user_id_fk => $user->{opt} => $user->{id},
|
|
mli_delete => '=' => 0,
|
|
mli_done => '=' => 0,
|
|
mli_scheduled => '=' => 0,
|
|
mli_cat_id_fk => '=' => 0,
|
|
);
|
|
my $drafts = $db_mli->select($cd)->rows;
|
|
my $scheduled = $db_mli->select({ mli_scheduled => 1, mli_delete => 0 })->rows;
|
|
|
|
return { results_draft => $draft, results_sent => $sent, scheduled_hits => $scheduled,
|
|
hits_draft => $#$draft + 1, hits_sent => $#$sent + 1, drafts => $drafts,
|
|
};
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_generate_bounce_code} = __LINE__ . <<'END_OF_SUB';
|
|
sub _generate_bounce_code {
|
|
# -------------------------------------------------------------------
|
|
my $code;
|
|
my $i;
|
|
while ($i++ < 10) {
|
|
$code = '';
|
|
my @chars = ('a' .. 'z', 'A' .. 'Z', 0 .. 9);
|
|
for (1 .. 20) {
|
|
$code .= $chars[rand @chars];
|
|
}
|
|
last unless ($DB->table('EmailMailings')->count( { eml_code => $code } ));
|
|
}
|
|
return $code;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_print_dot} = __LINE__ . <<'END_OF_SUB';
|
|
sub _print_dot {
|
|
my $num = shift;
|
|
foreach my $i(1..$num) {
|
|
print ".";
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_replace_url} = __LINE__ . <<'END_OF_SUB';
|
|
sub _replace_url {
|
|
my ($content, $url) = @_;
|
|
$url ||= '';
|
|
$content =~ s/href\s*=\s*(["'])\s*((?:https?|ftp):\/\/.*?)\1/my $link = $IN->escape($IN->html_unescape($2)); "href=$1$url;url=$link$1"/gise;
|
|
return $content;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
|
sub _determine_action {
|
|
#----------------------------------------------------------------------------
|
|
# Check valid action
|
|
#
|
|
my $action = shift || undef;
|
|
return if ( !$action );
|
|
return 'mli_home' if ( $action eq 'mli_search' );
|
|
|
|
my %valid = (
|
|
map { $_ => 1 } qw(
|
|
mli_home
|
|
mli_search_form
|
|
mli_empty
|
|
mli_delete
|
|
mli_move
|
|
mli_schedule
|
|
mli_schedule_modify
|
|
mli_schedule_delete
|
|
mli_send
|
|
mli_fview
|
|
mli_fdownload
|
|
mli_bounced_form
|
|
mli_bounced
|
|
mli_recipients
|
|
mli_cat_add
|
|
mli_cat_modify
|
|
mli_cat_delete
|
|
)
|
|
);
|
|
exists $valid{$action} and return $action;
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
1;
|