533 lines
19 KiB
Perl
533 lines
19 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: Tools.pm,v 1.37 2004/10/06 17:58:17 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::Tools;
|
|
|
|
use strict;
|
|
use GList qw/:objects $LANGUAGE $GLOBALS/;
|
|
|
|
use constants KB => 1024, MB => 1024 * 1024;
|
|
|
|
sub generate_used_bar {
|
|
#-------------------------------------------------------------------
|
|
#
|
|
my ($type, $max_width) = @_;
|
|
|
|
my ($percent, $img_width, $msg) = (0, 0, '');
|
|
if ($type eq 'email30') {
|
|
require GT::Date;
|
|
require GT::SQL::Condition;
|
|
my $last30 = GT::Date::date_sub(GT::Date::date_get(), 30);
|
|
my $unix_time = GList::date_to_time($last30);
|
|
my $num_sent = $DB->table('MailingIndex', 'EmailMailings')->count(
|
|
GT::SQL::Condition->new(
|
|
mli_user_id_fk => '=' => $USER->{usr_username},
|
|
eml_sent => '>=' => $unix_time
|
|
)
|
|
);
|
|
if ($num_sent >= $USER->{usr_limit_email30}) {
|
|
$percent = 100;
|
|
$img_width = $max_width;
|
|
}
|
|
else {
|
|
$percent = int(100 * $num_sent / $USER->{usr_limit_email30});
|
|
$img_width = int($num_sent * $max_width / $USER->{usr_limit_email30});
|
|
}
|
|
$msg = GList::language('SYS_USEDBAR_EMAIL30', $percent, $USER->{usr_limit_email30});
|
|
}
|
|
elsif ($type eq 'sublist') {
|
|
my $num_lists = $DB->table('Lists')->count({ lst_user_id_fk => $USER->{usr_username} });
|
|
my $num_subs = $DB->table('Subscribers')->count({ sub_user_id_fk => $USER->{usr_username} });
|
|
my $sub_limit = ($num_lists) ? $num_lists * $USER->{usr_limit_sublist} : $USER->{usr_limit_sublist};
|
|
if ($num_subs >= $sub_limit) {
|
|
$percent = 100;
|
|
$img_width = $max_width;
|
|
}
|
|
else {
|
|
$percent = int(100 * $num_subs / $sub_limit);
|
|
$img_width = int($num_subs * $max_width / $sub_limit);
|
|
}
|
|
$msg = GList::language('SYS_USEDBAR_SUBLIST', $percent, $sub_limit);
|
|
}
|
|
return { used_message => $msg, used_percent => $percent, used_image_width => $img_width };
|
|
}
|
|
|
|
sub generate_list {
|
|
# ------------------------------------------------------------------
|
|
# Generates a list of lists
|
|
#
|
|
my $object = shift;
|
|
|
|
my $tags = GT::Template->tags;
|
|
my $lists = $DB->table('Lists');
|
|
$lists->select_options('ORDER BY lst_Title');
|
|
|
|
my $sth = $lists->select({ lst_user_id_fk => $tags->{usr_username} }) or die $GT::SQL::error;
|
|
my $html = "";
|
|
my $current = $tags->{$object};
|
|
while ( my $rs = $sth->fetchrow_hashref ) {
|
|
if (ref $current eq 'ARRAY') {
|
|
my $id = 0;
|
|
foreach (@$current) {
|
|
if ($_ == $rs->{lst_id}) {
|
|
$id = $_;last;
|
|
}
|
|
}
|
|
$html .= ( $id == $rs->{lst_id} ) ? "<option value='$rs->{lst_id}' selected>$rs->{lst_title}</option>"
|
|
: "<option value='$rs->{lst_id}'>$rs->{lst_title}</option>";
|
|
}
|
|
else {
|
|
$html .= ( $current == $rs->{lst_id} ) ? "<option value='$rs->{lst_id}' selected>$rs->{lst_title}</option>"
|
|
: "<option value='$rs->{lst_id}'>$rs->{lst_title}</option>";
|
|
}
|
|
}
|
|
return $html;
|
|
}
|
|
|
|
sub default_email_editor {
|
|
#------------------------------------------------------------------
|
|
# Load the default email templates editor
|
|
#
|
|
my $tags = GT::Template->tags;
|
|
|
|
my $cgi = $IN->get_hash();
|
|
my $selected_dir = $cgi->{tpl_dir} || $CFG->{template_set} || 'gossamer';
|
|
|
|
my $demo;
|
|
#------------demo code-----------
|
|
|
|
# Build the select lists.
|
|
my $d_select_list = _template_dir_select();
|
|
my ($f_select_list, $selected_file) = _default_select("$CFG->{priv_path}/templates/$selected_dir", $cgi->{tpl_file});
|
|
|
|
return { select_list => $f_select_list, tpl_dir => "$CFG->{priv_path}/templates/", selected_dir => $selected_dir, dir_select => $d_select_list, demo => $demo, tpl_file => $selected_file, bload => ($selected_file) ? 1 : 0 };
|
|
}
|
|
|
|
sub email_editor {
|
|
#------------------------------------------------------------------
|
|
# Load the email template editor
|
|
#
|
|
my $tags = GT::Template->tags;
|
|
|
|
my $cgi = $IN->get_hash();
|
|
|
|
my $tpl = {};
|
|
my $db = $DB->table('EmailTemplates');
|
|
my $cols = $db->cols;
|
|
my ($msg, $error, $demo);
|
|
|
|
#------------demo code-----------
|
|
|
|
# Save the email template
|
|
my $save_as = $cgi->{save_as};
|
|
if ( $cgi->{bsave} and $save_as ) {
|
|
if ( $demo ) {
|
|
$msg = '<font color="red">Edit email template has been disabled in the demo!</font>';
|
|
}
|
|
else {
|
|
my @required = ('tpl_to', 'tpl_from', 'tpl_subject', 'tpl_body');
|
|
my $hsh = {};
|
|
foreach ( @required ) {
|
|
$hsh->{$_} = $cgi->{$_} if ( defined $cgi->{$_} );
|
|
}
|
|
$hsh->{tpl_user_id_fk} = $tags->{usr_username};
|
|
$hsh->{tpl_name} = $save_as;
|
|
if ( $cgi->{tpl_extra} ) {
|
|
for ( split /\s*\n\s*/, $cgi->{tpl_extra} ) { # This will weed out any blank lines
|
|
my ($key, $value) = split /\s*:\s*/, $_, 2;
|
|
$hsh->{tpl_extra} .= "$key: $value\n" if $key and $value;
|
|
}
|
|
}
|
|
else {
|
|
$hsh->{tpl_extra} = '';
|
|
}
|
|
|
|
foreach ( @required ) {
|
|
if ( !$hsh->{$_} ) {
|
|
$msg = GList::language('TPL_INVALID');
|
|
$error = 1;
|
|
last;
|
|
}
|
|
}
|
|
if ( !$msg ) {
|
|
if ( $save_as eq $cgi->{tpl_name} ) { # Update an exist template
|
|
$db->update($hsh, { tpl_user_id_fk => $tags->{usr_username}, tpl_name => $save_as });
|
|
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_UPDATED', $save_as);
|
|
}
|
|
else { # Add a new template
|
|
$db->insert($hsh);
|
|
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_ADDED', $save_as);
|
|
$cgi->{tpl_name} = $save_as if ( !$GT::SQL::error );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
elsif ( $cgi->{txtdelete} ) { # Delete an existing template
|
|
if ( $demo ) {
|
|
$msg = '<font color="red">Edit email template has been disabled in the demo !</font>';
|
|
}
|
|
else {
|
|
require GT::SQL::Condition;
|
|
my $cond = GT::SQL::Condition->new('lst_user_id_fk', '=', $tags->{usr_username});
|
|
$cond->add(GT::SQL::Condition->new('lst_opt_template', '=', $cgi->{tpl_name}, 'lst_subs_template', '=', $cgi->{tpl_name}, 'lst_unsubs_template', '=', $cgi->{tpl_name}, 'OR'));
|
|
|
|
my $sth = $DB->table('Lists')->select($cond);
|
|
if ( $sth->rows ) {
|
|
$msg = GList::language('TPL_DELETE_ERROR', $cgi->{tpl_name});
|
|
}
|
|
else {
|
|
$db->delete({ tpl_user_id_fk => $tags->{usr_username}, tpl_name => $cgi->{tpl_name} });
|
|
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_DELETED', $cgi->{tpl_name});
|
|
}
|
|
}
|
|
}
|
|
elsif ( $cgi->{bdefault} ) { # Load default templates
|
|
GList::set_default_template('validation.eml', $tags->{usr_username});
|
|
GList::set_default_template('subscribe.eml', $tags->{usr_username});
|
|
GList::set_default_template('unsubscribe.eml', $tags->{usr_username});
|
|
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_LOADED');
|
|
}
|
|
|
|
# Build the select lists.
|
|
my $f_current_list = _current_select('tpl_name', $cgi->{tpl_name});
|
|
if ( $cgi->{tpl_name} and !$GT::SQL::error and !$error ) {
|
|
$tpl = $db->get({ tpl_user_id_fk => $tags->{usr_username}, tpl_name => $cgi->{tpl_name} });
|
|
if ( !$tpl ) {
|
|
foreach (keys %$cols) { $tpl->{$_} = ''; }
|
|
}
|
|
}
|
|
|
|
return { current_list => $f_current_list, msg => $msg, %$tpl };
|
|
}
|
|
|
|
sub template_editor {
|
|
# ------------------------------------------------------------------
|
|
# Loads the template editor.
|
|
#
|
|
_editor_obj()->process;
|
|
}
|
|
|
|
sub language_editor {
|
|
# ------------------------------------------------------------------
|
|
# Loads the language file editor.
|
|
#
|
|
my $tags = GT::Template->tags;
|
|
|
|
my ($font, $message, $table);
|
|
my $cgi = $IN->get_hash;
|
|
my $selected_dir = $cgi->{tpl_dir} || $CFG->{template_set} || 'gossamer';
|
|
|
|
$font = 'face="Tahoma,Arial,Helvetica" size="2"';
|
|
|
|
my $demo;
|
|
#------------demo code-----------
|
|
|
|
GList::load_language($selected_dir);
|
|
|
|
if ($cgi->{save}) {
|
|
if ($demo) {
|
|
$message = '<font color="red">The language editor has been disabled in the demo!</font>';
|
|
}
|
|
else {
|
|
my $need_save;
|
|
foreach my $code (keys %$cgi) {
|
|
if ($code =~ /^del-(.*)$/) {
|
|
delete $LANGUAGE->{$1};
|
|
++$need_save;
|
|
}
|
|
elsif ($code =~ /^save-(.*)/) {
|
|
my $key = $1;
|
|
next if $cgi->{"del-$key"};
|
|
my $var = $cgi->{$code};
|
|
$var =~ s/\r\n/\n/g; # Remove windows linefeeds.
|
|
next if exists $LANGUAGE->{$key} and $LANGUAGE->{$key} eq $var;
|
|
$LANGUAGE->{$key} = $var;
|
|
++$need_save;
|
|
}
|
|
}
|
|
|
|
if (my $key = $cgi->{new} and my $var = $cgi->{'new-val'}) {
|
|
$var =~ s/\r\n/\n/g;
|
|
if ($key =~ /^([^_]*)_/) {
|
|
$LANGUAGE->{$key} = $var;
|
|
++$need_save;
|
|
}
|
|
else {
|
|
$message = GList::language('TPL_LANG_INVALID');
|
|
}
|
|
}
|
|
elsif ($cgi->{'new-val'}) {
|
|
$message = GList::language('TPL_LANG_ERROR');
|
|
}
|
|
|
|
if ($need_save) {
|
|
$LANGUAGE->save();
|
|
$LANGUAGE = undef; # Force a reload to catch inherited values
|
|
$message = GList::language('TPL_LANG_SAVED');
|
|
$tags->{'new-val'} = '';
|
|
}
|
|
}
|
|
}
|
|
|
|
my $prefix = $cgi->{'prefix'};
|
|
my %prefix_list;
|
|
foreach my $code (sort keys %$LANGUAGE) {
|
|
if ($code =~ /^([^_]*)_/) {
|
|
$prefix_list{$1}++;
|
|
}
|
|
next if $prefix and $code !~ /^$prefix\_/;
|
|
my $lang = $IN->html_escape($LANGUAGE->{$code});
|
|
$table .= <<HTML;
|
|
<tr>
|
|
<td valign=top><font $font>$code</font></td>
|
|
<td>
|
|
<textarea rows="5" cols="50" name="save-$code" class="object">$lang</textarea>
|
|
</td>
|
|
<td><input type=checkbox name="del-$code" value="1" /></td>
|
|
</tr>
|
|
HTML
|
|
}
|
|
my $prefix_output = join " | ",
|
|
map qq'<a href="$CFG->{cgi_url}/glist.cgi?do=admin_page;pg=admin_template_language.html;prefix=$_;tpl_dir=$selected_dir"><nobr>$_ ($prefix_list{$_})</nobr></a>',
|
|
sort keys %prefix_list;
|
|
|
|
my $d_select_list = _template_dir_select();
|
|
|
|
return {
|
|
language_table => $table,
|
|
prefix => $prefix,
|
|
dir_select => $d_select_list,
|
|
message => $message,
|
|
prefix_list => $prefix_output
|
|
};
|
|
}
|
|
|
|
sub global_editor {
|
|
# ------------------------------------------------------------------
|
|
# Loads the global template vars.
|
|
#
|
|
my $tags = GT::Template->tags;
|
|
my ($dir, $font, $file, $message, $table);
|
|
my $cgi = $IN->get_hash();
|
|
|
|
my $selected_dir = $cgi->{tpl_dir} || $CFG->{template_set} || 'gossamer';
|
|
$dir = $CFG->{priv_path} . "/templates/common";
|
|
|
|
GList::load_globals(1);
|
|
|
|
my $demo;
|
|
#------------demo code-----------
|
|
|
|
if ($cgi->{save}) {
|
|
if ($demo) {
|
|
$message = '<font color="red">The global editor has been disabled in the demo!</font>';
|
|
}
|
|
else {
|
|
my $need_save;
|
|
foreach my $code (keys %$cgi) {
|
|
if ($code =~ /^del-(.*)$/) {
|
|
delete $GLOBALS->{$1};
|
|
++$need_save;
|
|
}
|
|
elsif ($code =~ /^save-(.*)/) {
|
|
my $key = $1;
|
|
next if $cgi->{"del-$key"};
|
|
my $var = $cgi->{$code};
|
|
$var =~ s/\r\n/\n/g; # Remove windows linefeeds.
|
|
next if exists $GLOBALS->{$key} and $GLOBALS->{$key} eq $var;
|
|
$GLOBALS->{$key} = $var;
|
|
++$need_save;
|
|
}
|
|
}
|
|
|
|
if (my $key = $cgi->{new} and my $var = $cgi->{'new-val'}) {
|
|
$var =~ s/\r\n/\n/g;
|
|
$GLOBALS->{$key} = $var;
|
|
++$need_save;
|
|
}
|
|
elsif ($cgi->{'new-val'}) {
|
|
$message = GList::language('TPL_GLOBAL_ERROR');
|
|
}
|
|
|
|
if ($need_save) {
|
|
$GLOBALS->save();
|
|
$GLOBALS = undef; # Force a reload, to catch inherited/local values
|
|
GList::load_globals(1);
|
|
$message = GList::language('TPL_GLOBAL_SAVED');
|
|
$tags->{'new-val'} = '';
|
|
}
|
|
}
|
|
}
|
|
for my $code (sort keys %$GLOBALS) {
|
|
my $val = $IN->html_escape($GLOBALS->{$code});
|
|
$table .= <<HTML;
|
|
<tr>
|
|
<td valign="top" class="body">$code</td>
|
|
<td>
|
|
<textarea rows="5" cols="50" name="save-$code" wrap="off" class="object">$val</textarea>
|
|
</td>
|
|
<td><input type="checkbox" name="del-$code" value="1"></td>
|
|
</tr>
|
|
HTML
|
|
}
|
|
return { global_table => $table, message => $message };
|
|
}
|
|
|
|
sub convert_date {
|
|
#----------------------------------------------------------------------
|
|
my $time = shift or return GList::language('ADMNEVER_LOGIN');
|
|
my $format = "%mm%-%dd%-%yyyy% %hh%:%MM%:%ss%";
|
|
|
|
require GT::Date;
|
|
return GT::Date::date_get($time, $format);
|
|
}
|
|
|
|
sub friendly_size {
|
|
my $size = shift;
|
|
return $size <= 100
|
|
? "$size " . GList::language('FILESIZE_BYTES')
|
|
: $size < 10 * KB
|
|
? sprintf("%.2f ", $size / KB) . GList::language('FILESIZE_KILOBYTES')
|
|
: $size < 100 * KB
|
|
? sprintf("%.1f ", $size / KB) . GList::language('FILESIZE_KILOBYTES')
|
|
: $size < MB
|
|
? sprintf("%.0f ", $size / KB) . GList::language('FILESIZE_KILOBYTES')
|
|
: $size < 10 * MB
|
|
? sprintf("%.2f ", $size / MB) . GList::language('FILESIZE_MEGABYTES')
|
|
: $size < 100 * MB
|
|
? sprintf("%.1f ", $size / MB) . GList::language('FILESIZE_MEGABYTES')
|
|
: sprintf("%.0f ", $size / MB) . GList::language('FILESIZE_MEGABYTES');
|
|
}
|
|
|
|
sub list_title {
|
|
my $list_id = shift;
|
|
return if (!$list_id);
|
|
|
|
my $info = $DB->table('Lists')->get($list_id);
|
|
return $info->{lst_title};
|
|
}
|
|
|
|
sub _editor_obj {
|
|
my ($name, $skip) = @_;
|
|
$skip ||= [qw/CVS safe help/];
|
|
require GT::Template::Editor;
|
|
my $demo = 0;
|
|
|
|
#------------demo code-----------
|
|
|
|
GT::Template::Editor->new(
|
|
root => "$CFG->{priv_path}/templates",
|
|
backup => $CFG->{template_backups},
|
|
cgi => $IN,
|
|
demo => $demo,
|
|
class => "object",
|
|
default_dir => $CFG->{template_set} || 'gossamer',
|
|
skip_dir => $skip,
|
|
skip_file => [qw/*.eml/],
|
|
$name ? (select_dir => $name) : ()
|
|
);
|
|
}
|
|
|
|
sub _template_dir_select {
|
|
# ------------------------------------------------------------------
|
|
# Returns a select list of template directories.
|
|
#
|
|
my $name = shift;
|
|
_editor_obj($name, [qw/CVS help safe common/])->template_dir_select;
|
|
}
|
|
|
|
sub _current_select {
|
|
# ------------------------------------------------------------------
|
|
# Returns a select list of user email templates
|
|
#
|
|
my ($name, $selected_file) = @_;
|
|
|
|
my $tags = GT::Template->tags;
|
|
|
|
my $sth = $DB->table('EmailTemplates')->select({ tpl_user_id_fk => $tags->{usr_username} }, ['tpl_name']);
|
|
return if ( !$sth->rows );
|
|
$selected_file ||= $tags->{$name};
|
|
|
|
my $f_select_list = "<select name='$name' class=object><option value=''>".GList::language('TPL_SELECT_TITLE')."</option>";
|
|
while ( my $name = $sth->fetchrow_array ) {
|
|
( $selected_file eq $name ) ? ($f_select_list .= "<option selected>$name") : ($f_select_list .= "<option>$name");
|
|
}
|
|
|
|
return "$f_select_list</select>";
|
|
}
|
|
|
|
sub _default_select {
|
|
# ------------------------------------------------------------------
|
|
# Returns a select list of email templates in a given dir.
|
|
#
|
|
my ( $dir, $selected_file ) = @_;
|
|
|
|
my ($file, @files);
|
|
opendir (TPL, $dir) or die GList::language('DIR_OPEN_ERR', $dir, $!);
|
|
|
|
while (defined($file = readdir TPL)) {
|
|
my ($ext) = $file =~ /\.([^.]+)$/;
|
|
next unless $ext and $ext eq 'eml';
|
|
push @files, $file;
|
|
}
|
|
closedir TPL;
|
|
|
|
my $f_select_list = "<select name='tpl_file' class=object><option value=''>".GList::language('TPL_SELECT_TITLE')."</option>";
|
|
my $count = 0;
|
|
foreach (sort @files) {
|
|
$selected_file = $_ if (!$selected_file and !$count);
|
|
($selected_file eq $_) ? ($f_select_list .= "<option selected>$_</option>") : ($f_select_list .= "<option>$_</option>");
|
|
}
|
|
$f_select_list .= "</select>";
|
|
|
|
return ($f_select_list, $selected_file);
|
|
}
|
|
|
|
sub schedule_status {
|
|
my $tags = GT::Template->tags;
|
|
my ($scm_id, $scm_sent, $scm_type) = ($tags->{scm_id}, $tags->{scm_sent}, $tags->{scm_type});
|
|
|
|
my $schedule = $DB->table('ScheduledMailings')->get({ scm_id => $scm_id });
|
|
return unless $schedule;
|
|
return unless $scm_sent;
|
|
|
|
require GT::Date;
|
|
if ($scm_type == 2) {
|
|
return 1 if GT::Date::date_get(time, "%yyyy%-%mm%-%dd%") eq GT::Date::date_get($scm_sent, "%yyyy%-%mm%-%dd%");
|
|
}
|
|
elsif ($scm_type == 3) {
|
|
my $today = GT::Date::date_get(time, "%yyyy%-%mm%-%dd%");
|
|
my $next_7days = GT::Date::date_add(GT::Date::date_get($scm_sent, "%yyyy%-%mm%-%dd%"), 7);
|
|
return GT::Date::date_is_greater($next_7days, $today);
|
|
}
|
|
elsif ($scm_type == 4) {
|
|
return 1 if GT::Date::date_get(time, "%mm%") eq GT::Date::date_get($scm_sent, "%mm%");
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub schedule_info {
|
|
my $mli_id = shift;
|
|
|
|
return unless $mli_id;
|
|
my $info = $DB->table('ScheduledMailings')->get({ scm_mailing_id_fk => $mli_id });
|
|
if ($info->{scm_type} == 1) {
|
|
require GT::Date;
|
|
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
|
$info->{scm_option} = GT::Date::date_get($info->{scm_option}, $format);
|
|
}
|
|
return $info;
|
|
}
|
|
1;
|