1345 lines
46 KiB
Perl
1345 lines
46 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: Admin.pm,v 1.59 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::Admin;
|
|
|
|
use strict;
|
|
use GList qw/:user_type :objects $DEBUG/;
|
|
use GT::AutoLoader;
|
|
|
|
sub process {
|
|
#------------------------------------------------------------------
|
|
# Setermine what to do
|
|
#
|
|
my $do = shift;
|
|
|
|
my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
|
|
if ($action eq 'admin_gtdoc') {
|
|
return GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
|
|
}
|
|
|
|
my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
|
|
if ($tpl) {
|
|
$MN_SELECTED = 6 if ($tpl =~ /^admin_user/);
|
|
my $hidden = GList::hidden();
|
|
$results->{hidden_query} = $hidden->{hidden_query};
|
|
$results->{hidden_objects} = $hidden->{hidden_objects};
|
|
GList::display($tpl, $results);
|
|
}
|
|
}
|
|
|
|
$COMPILE{admin_gtdoc} = <<'END_OF_SUB';
|
|
sub admin_gtdoc {
|
|
#-------------------------------------------------------------------
|
|
#
|
|
my $template = $IN->param('topic') || 'index.html';
|
|
|
|
my $help_path = "$CFG->{priv_path}/templates/help";
|
|
$template =~ s,^/|/$,,;
|
|
|
|
# Check the topic file.
|
|
unless ( $template =~ /^[\w\/]+\.[\w]+$/ ) {
|
|
die "Invalid topic: $template";
|
|
}
|
|
if ( $template =~ /\.(gif|jpg)$/ and -e "$help_path/$template" ) {
|
|
print $IN->header("image/$1");
|
|
open IMG, "< $help_path/$template" or die "Unable to open image help: $help_path/$template ($!)";
|
|
binmode IMG;
|
|
local *BINSTDOUT;
|
|
open BINSTDOUT, ">&STDOUT";
|
|
binmode BINSTDOUT;
|
|
print BINSTDOUT while <IMG>;
|
|
close IMG;
|
|
}
|
|
else {
|
|
print $IN->header;
|
|
GT::Template->parse ($template, $USER, { print => 1, root => $help_path });
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_page} = <<'END_OF_SUB';
|
|
sub admin_page {
|
|
#--------------------------------------------------------------------
|
|
#
|
|
my ($page, $vars) = @_;
|
|
|
|
$page ||= $IN->param('pg');
|
|
( $page ) or return admin_user(GList::language('ADM_INVALID'));
|
|
|
|
if ( $page =~ /^admin_template_/ ) {
|
|
$MN_SELECTED = 7;
|
|
}
|
|
elsif ( $page =~ /plugin_|gt_doc/ ) {
|
|
$MN_SELECTED = 8;
|
|
}
|
|
elsif ( $page =~ /admin_setup_/ ) {
|
|
$MN_SELECTED = 9;
|
|
}
|
|
|
|
return ($page, $vars);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_initial_sql} = <<'END_OF_SUB';
|
|
sub admin_initial_sql {
|
|
#-------------------------------------------------------------------
|
|
#
|
|
my $sql = _sql_load_cfg();
|
|
unless ( $IN->param('setup_sql') ) {
|
|
return ('admin_initial_sql.html', { %$sql, msg => GList::language("ADM_CONNECTION_ERROR") });
|
|
}
|
|
my $do = $IN->param('action');
|
|
if ($do !~ /^create|overwrite|load$/) {
|
|
return ('admin_initial_sql.html', { msg => "<font color=red><b>Invalid action: '$do'</b></font>", $sql });
|
|
}
|
|
|
|
my $ret = _sql_connect($IN->param('sql_host'), $IN->param('sql_driver'), $IN->param('sql_database'), $IN->param('sql_login'), $IN->param('sql_password'), $IN->param('sql_prefix'));
|
|
if (exists $ret->{error}) {
|
|
return ('admin_initial_sql.html', { msg => $ret->{error}, $sql });
|
|
}
|
|
|
|
my $output;
|
|
if ($do eq 'create') {
|
|
$output = GList::SQL::tables('check');
|
|
}
|
|
elsif ($do eq 'overwrite') {
|
|
$output = GList::SQL::tables('force');
|
|
}
|
|
elsif ($do eq 'load') {
|
|
$output = GList::SQL::load_from_sql();
|
|
}
|
|
|
|
if ( !$DB->table('Users')->count({ usr_Username => $USER->{username}}) ) {
|
|
my $user = $CFG->{admin}->{$USER->{username}};
|
|
my %hash;
|
|
$hash{usr_type} = ADMINISTRATOR;
|
|
$hash{usr_username} = $USER->{username};
|
|
$hash{usr_password} = $user->[0];
|
|
$hash{usr_email} = $user->[1];
|
|
$hash{pro_first_name} = $USER->{username};
|
|
$hash{pro_last_name} = $USER->{username};
|
|
$hash{usr_date_format} = '%yyyy%-%mm%-%dd%';
|
|
$DB->table('Users')->insert(%hash) or die $GT::SQL::error;
|
|
}
|
|
|
|
my $results = GList::Authenticate::auth('create_session', { username => $USER->{username} });
|
|
( $results->{error} ) and return ('login_form.html', { msg => "<font color=red><b>$results->{error}</b></font>" });
|
|
|
|
# Delete session file if it has being used
|
|
GList::Authenticate::auth('admin_delete_session');
|
|
|
|
# Administrator users need to be saved in Data.pm
|
|
_save_users();
|
|
|
|
return ('admin_initial_sql_results.html', { msg => $output });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_initial_setup} = <<'END_OF_SUB';
|
|
sub admin_initial_setup {
|
|
# ------------------------------------------------------------------
|
|
# Sets the mysql information.
|
|
#
|
|
my ($host, $port, $overwrite);
|
|
|
|
unless ( $IN->param('initial_step') ) {
|
|
return admin_page('admin_initial_setup_first.html');
|
|
}
|
|
if ( $IN->param('initial_step') == 2 ) {
|
|
return admin_page('admin_initial_setup_second.html');
|
|
}
|
|
|
|
# Test the ability to create a def file.
|
|
unless (open (TEST, "> $CFG->{priv_path}/defs/database.def")) {
|
|
return ('admin_initial_setup_second.html', { error => sprintf(GList::language('ADM_INITIAL_ERROR'), "$CFG->{priv_path}/defs/", $!) });
|
|
}
|
|
close TEST;
|
|
unlink "$CFG->{priv_path}/defs/database.def";
|
|
|
|
# Set the connection info.
|
|
$overwrite = $IN->param('overwrite') ? 'force' : 'check';
|
|
$host = $IN->param('host');
|
|
($host =~ s/\:(\d+)$//) and ($port = $1);
|
|
|
|
my $prefix = $IN->param('prefix');
|
|
$prefix =~ /^\w*$/ or return ('admin_initial_setup_second.html', { error => sprintf(GList::language('ADM_INITIAL_PREFIX_ERROR'), $prefix) });
|
|
|
|
$DB->prefix($prefix);
|
|
my $ret = $DB->set_connect ({
|
|
driver => scalar $IN->param('driver'),
|
|
host => $host,
|
|
port => $port,
|
|
database => scalar $IN->param('database'),
|
|
login => scalar $IN->param('login'),
|
|
password => scalar $IN->param('password'),
|
|
RaiseError => 0,
|
|
PrintError => 0,
|
|
AutoCommit => 1
|
|
});
|
|
if (! defined $ret) {
|
|
return ('admin_initial_setup_second.html', { error => $GT::SQL::error });
|
|
}
|
|
# Now let's create the tables.
|
|
eval { local $SIG{__DIE__}; require GList::SQL; };
|
|
if ($@) { return ('admin_initial_setup_second.html', { error => sprintf(GList::language('ADM_INITIAL_LOAD_ERROR'), "$@\n") }); }
|
|
my $output = GList::SQL::tables($overwrite);
|
|
|
|
# Remove admin users and Add an admin user
|
|
|
|
my $user;
|
|
foreach (keys % {$CFG->{admin}}) {
|
|
$user = $_;last;
|
|
}
|
|
if ($user) {
|
|
my $db = $DB->table('Users');
|
|
$db->delete({ usr_type => ADMINISTRATOR });
|
|
if ( !$db->insert({
|
|
usr_username => $user,
|
|
usr_email => $CFG->{admin}->{$user}->[1],
|
|
usr_password => $CFG->{admin}->{$user}->[0],
|
|
usr_type => ADMINISTRATOR,
|
|
usr_reply_email => $CFG->{admin}->{$user}->[1],
|
|
usr_bounce_email => $CFG->{admin}->{$user}->[1],
|
|
usr_date_format => '%yyyy%-%mm%-%dd%',
|
|
pro_first_name => $user,
|
|
pro_last_name => $user,
|
|
}) ) {
|
|
return ('admin_initial_setup_second.html', { error => $GT::SQL::error });
|
|
}
|
|
}
|
|
|
|
# Set default email templates
|
|
GList::set_default_template('validation.eml', $IN->param('admin_user'));
|
|
GList::set_default_template('subscribe.eml', $IN->param('admin_user'));
|
|
GList::set_default_template('unsubscribe.eml', $IN->param('admin_user'));
|
|
|
|
# And lets set sensible defaults for the rest of the config vars.
|
|
$CFG->create_defaults();
|
|
|
|
# And save the config.
|
|
$CFG->save();
|
|
|
|
return ('admin_initial_setup_third.html', { message => sprintf(GList::language('ADM_INITIAL_SUCCESSFUL'), $output) } );
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user} = <<'END_OF_SUB';
|
|
sub admin_user {
|
|
#--------------------------------------------------------------------
|
|
# Print home page
|
|
#
|
|
my $msg = shift;
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $cgi = $IN->get_hash;
|
|
my $search_check = ($IN->param('do') eq 'admin_user_search') ? 1 : 0;
|
|
my $results = GList::search(
|
|
cgi => $cgi,
|
|
db => $DB->table('Users'),
|
|
prefix => 'usr',
|
|
sb => 'usr_type',
|
|
so => 'ASC',
|
|
skip_user => '1',
|
|
search_check=> $search_check
|
|
);
|
|
|
|
if ( ref $results ne 'HASH' ) {
|
|
( $IN->param('do') eq 'admin_user_search' ) ? return ('admin_user_search_form.html', { msg => $results })
|
|
: return ('admin_user_home.html', { msg => $results });
|
|
}
|
|
elsif ( $results->{error} and $search_check) {
|
|
return ('admin_user_search_form.html', { msg => $results->{error} })
|
|
}
|
|
|
|
my $output = $results->{results};
|
|
$results->{msg} = ($msg) ? $msg : GList::language('USR_RESULTS', $results->{hits});
|
|
|
|
return ('admin_user_home.html', $results);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_add} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_add {
|
|
#--------------------------------------------------------------------
|
|
# Add a user
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $cols = $DB->table('Users')->cols;
|
|
my $cgi = {};
|
|
|
|
foreach ( keys % $cols) {
|
|
$cgi->{$_} = $IN->param("mod_$_") if ( $IN->param("mod_$_") );
|
|
}
|
|
|
|
($cgi->{usr_username} and $cgi->{usr_username} =~ /^[\w\-\.]{3,}$/) or return ('admin_user_add_form.html', { msg => GList::language('USR_INVALID') });
|
|
($cgi->{usr_password} and length $cgi->{usr_password} < 4 ) and return ('admin_user_add_form.html', { msg => GList::language('ADM_PWD_INVALID') });
|
|
|
|
$cgi->{usr_password} = GList::encrypt($cgi->{usr_password});
|
|
$cgi->{usr_date_format} = $IN->param('date_preview') if ($IN->param('date_preview'));
|
|
$cgi->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
|
|
|
|
# Set account limits
|
|
$cgi = _account_limit($cgi);
|
|
|
|
# Add a new record
|
|
GList::add('Users', 'usr', $cgi);
|
|
|
|
return ('admin_user_add_form.html', { msg => sprintf(GList::language('USR_ADD_ERR', $GList::error)) }) if ( $GList::error );
|
|
|
|
# Add user info into Data.pm if user is a administrator
|
|
if ( $cgi->{usr_type} == ADMINISTRATOR and not exists $CFG->{admin}->{$cgi->{usr_username}}) {
|
|
$CFG->{admin}->{$cgi->{usr_username}} = [$cgi->{usr_password}, $cgi->{usr_email}];
|
|
$CFG->save();
|
|
}
|
|
|
|
# Set default email templates
|
|
GList::set_default_template('validation.eml', $cgi->{usr_username});
|
|
GList::set_default_template('subscribe.eml', $cgi->{usr_username});
|
|
GList::set_default_template('unsubscribe.eml', $cgi->{usr_username});
|
|
|
|
admin_user(sprintf(GList::language('USR_ADDED'), $cgi->{usr_username}));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_modify_form} = <<'END_OF_SUB';
|
|
sub admin_user_modify_form {
|
|
#-----------------------------------------------------------
|
|
# Print modify a user form
|
|
#
|
|
my $msg = shift;
|
|
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $id = $IN->param('uid');
|
|
my $db = $DB->table('Users');
|
|
my $user = $db->get($id);
|
|
( $user ) or return admin_user(sprintf(GList::language('USR_NOT_FOUND'), $id));
|
|
|
|
my $cols = $db->cols;
|
|
my $hsh = {};
|
|
foreach ( keys % $cols ) {
|
|
$hsh->{"mod_$_"} = $user->{$_};
|
|
}
|
|
return ('admin_user_modify_form.html', { msg => $msg, modify => 1, %$hsh });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_modify} = <<'END_OF_SUB';
|
|
sub admin_user_modify {
|
|
#-----------------------------------------------------------
|
|
# Modify a user
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $db = $DB->table('Users');
|
|
my $cols = $db->cols;
|
|
my $hsh = {};
|
|
my $cgi = $IN->get_hash();
|
|
|
|
foreach ( keys % $cols) {
|
|
next if ( $USER->{usr_username} eq $cgi->{mod_usr_username} and $_ eq 'usr_type' );
|
|
$hsh->{$_} = $cgi->{"mod_$_"} if (exists $cgi->{"mod_$_"});
|
|
}
|
|
|
|
# Setup the language for GT::SQL.
|
|
local $GT::SQL::ERRORS->{ILLEGALVAL} = GList::language('USR_ILLEGALVAL') if ( GList::language('USR_ILLEGALVAL') );
|
|
local $GT::SQL::ERRORS->{UNIQUE} = GList::language('USR_UNIQUE') if ( GList::language('USR_UNIQUE') );
|
|
local $GT::SQL::ERRORS->{NOTNULL} = GList::language('USR__NOTNULL') if ( GList::language('USR__NOTNULL') );
|
|
|
|
$hsh->{usr_cookie} = 0 if ( !defined $hsh->{usr_cookie} );
|
|
if ($hsh->{usr_type} == ADMINISTRATOR or $hsh->{usr_type} == UNLIMITED_USER) {
|
|
$hsh->{usr_validate_code} = '';
|
|
}
|
|
|
|
if ($hsh->{usr_password}) {
|
|
$hsh->{usr_password} = GList::encrypt($hsh->{usr_password});
|
|
}
|
|
else {
|
|
delete $hsh->{usr_password};
|
|
}
|
|
|
|
$hsh->{usr_date_format} = $IN->param('date_preview') if ($IN->param('date_preview'));
|
|
$hsh->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
|
|
my $old = $db->get($hsh->{usr_username});
|
|
|
|
# Set account limits
|
|
$hsh = _account_limit($hsh);
|
|
|
|
# Email validate this account
|
|
if ($CFG->{signup_admin_validate} and $cgi->{email_validate}) {
|
|
$hsh->{usr_validate_code} = '';
|
|
}
|
|
|
|
if ( $db->modify($hsh) ) {
|
|
my $pass = $hsh->{usr_password} || $old->{usr_password};
|
|
if ( $old->{usr_type} ne $hsh->{usr_type} ) { # Update Data.pm
|
|
if ( $hsh->{usr_type} == ADMINISTRATOR ) {
|
|
exists $CFG->{admin}->{$hsh->{usr_username}} or $CFG->{admin}->{$hsh->{usr_username}} = [$pass, $hsh->{usr_email}];
|
|
}
|
|
else {
|
|
exists $CFG->{admin}->{$hsh->{usr_username}} and delete $CFG->{admin}->{$hsh->{usr_username}};
|
|
}
|
|
$CFG->save();
|
|
}
|
|
elsif ($hsh->{usr_type}) {
|
|
$CFG->{admin}->{$hsh->{usr_username}} = [$pass, $hsh->{usr_email}];
|
|
$CFG->save();
|
|
}
|
|
return admin_user(sprintf(GList::language('USR_UPDATED'), $hsh->{usr_username}));
|
|
}
|
|
else {
|
|
local $^W;
|
|
return admin_user_modify_form("<font color='red'>$GT::SQL::error</font>");
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_delete} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_delete {
|
|
#-------------------------------------------------------------------
|
|
# Delete the glist users
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $cgi = $IN->get_hash();
|
|
my $dels = (ref $cgi->{modify} eq 'ARRAY') ? $cgi->{modify} : [$cgi->{modify}];
|
|
my (%hsh, @mods, @users);
|
|
foreach (@$dels) {
|
|
next if ($cgi->{"$_-usr_username"} eq $USER->{usr_username});
|
|
$hsh{"$_-usr_username"} = $cgi->{"$_-usr_username"};
|
|
push @mods, $_;
|
|
push @users, $cgi->{"$_-usr_username"};
|
|
}
|
|
$hsh{modify} = \@mods;
|
|
|
|
my $msg = GList::delete('Users', 'usr', \%hsh);
|
|
|
|
# Delete users from Data.pm if they are administrator users
|
|
foreach my $u (@users) {
|
|
next if (not exists $CFG->{admin}->{$u});
|
|
delete $CFG->{admin}->{$u};
|
|
$CFG->save();
|
|
}
|
|
return admin_user($msg);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_validate} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_validate {
|
|
#-------------------------------------------------------
|
|
# Validate users
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $cgi = $IN->get_hash();
|
|
my $mod = (ref $cgi->{modify} eq 'ARRAY') ? $cgi->{modify} : [$cgi->{modify}];
|
|
|
|
my $db_usr = $DB->table('Users');
|
|
my $count = 0;
|
|
foreach (@$mod) {
|
|
my $u = $cgi->{"$_-usr_username"};
|
|
next if (!$u or $u eq $USER->{usr_username});
|
|
if ($db_usr->count({ usr_username => $u })) {
|
|
$db_usr->update({
|
|
usr_type => LIMITED_USER,
|
|
usr_validate_code => '',
|
|
usr_limit_list => $CFG->{signup_limit_list} || 10,
|
|
usr_limit_sublist => $CFG->{signup_limit_sublist} || 10,
|
|
usr_limit_email30 => $CFG->{signup_limit_email30} || 100,
|
|
}, { usr_username => $u });
|
|
$count++;
|
|
}
|
|
}
|
|
return admin_user(GList::language('USR_VALIDATED', $count));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_plugin} = <<'END_OF_SUB';
|
|
sub admin_plugin {
|
|
# ------------------------------------------------------------------
|
|
# Run a plugin function.
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $plugin = $IN->param('plugin');
|
|
my $func = $IN->param('func');
|
|
{
|
|
local ($@, $!, $SIG{__DIE__});
|
|
eval { require "$CFG->{priv_path}/lib/GList/Plugins/$plugin.pm"; };
|
|
if ( $@ ) {
|
|
return ('error_form.html', { msg => "<font color=red>Unable to load plugin: $plugin ($@)</font>" });
|
|
}
|
|
}
|
|
no strict 'refs';
|
|
my $code = ${"GList::Plugins::" . $plugin . "::"}{$func};
|
|
use strict 'refs';
|
|
|
|
if ( !defined $code ) {
|
|
return ('error_form.html', { msg => "<font color=red>Invalid plugin function: $func</font>" });
|
|
}
|
|
$code->();
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
$COMPILE{admin_setup_sql_form} = <<'END_OF_SUB';
|
|
sub admin_setup_sql_form {
|
|
# ------------------------------------------------------------------
|
|
# Print SQL Server Form
|
|
#
|
|
my $msg = shift;
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $sql = _sql_load_cfg();
|
|
return ('admin_setup_sql_form.html', { msg => $msg, %$sql });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_setup_sql} = <<'END_OF_SUB';
|
|
sub admin_setup_sql {
|
|
# ------------------------------------------------------------------
|
|
# Change the sql server information.
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my ($host, $port, $output, $do, $ret);
|
|
|
|
$do = $IN->param('action');
|
|
if ($do !~ /^create|overwrite|load$/) {
|
|
return admin_setup_sql_form("<font color=red><b>Invalid action: '$do'</b></font>");
|
|
}
|
|
|
|
$ret = _sql_connect($IN->param('sql_host'), $IN->param('sql_driver'), $IN->param('sql_database'), $IN->param('sql_login'), $IN->param('sql_password'), $IN->param('sql_prefix'));
|
|
if (exists $ret->{error}) {
|
|
return admin_setup_sql_form($ret->{error});
|
|
}
|
|
|
|
require GList::SQL;
|
|
if ($do eq 'create') {
|
|
$output = GList::SQL::tables('check');
|
|
}
|
|
elsif ($do eq 'overwrite') {
|
|
$output = GList::SQL::tables('force');
|
|
my $db = $DB->table('Users');
|
|
$db->insert($USER) or die $GT::SQL::error;
|
|
|
|
my $results = GList::Authenticate::auth('create_session', { username => $USER->{usr_username} });
|
|
( $results->{error} ) and return ('login_form.html', { msg => "<font color=red><b>$results->{error}</b></font>" });
|
|
|
|
# Save username and password into Data.pm
|
|
$CFG->{admin} = { $USER->{usr_username} => [$USER->{usr_password}, $USER->{usr_email}] };
|
|
$CFG->save();
|
|
}
|
|
elsif ($do eq 'load') {
|
|
$output = GList::SQL::load_from_sql();
|
|
}
|
|
|
|
return admin_setup_sql_form("<font color=green>$output", 'is_set');
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_setup_form} = <<'END_OF_SUB';
|
|
sub admin_setup_form {
|
|
# ------------------------------------------------------------------
|
|
# Print Setup form
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $msg = shift;
|
|
require GList::Config;
|
|
my $cfg = GList::Config::tpl_load();
|
|
my $pg = $IN->param('pg') || 'admin_setup_path.html';
|
|
|
|
return ($pg, { %$cfg, msg => $msg });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_setup} = <<'END_OF_SUB';
|
|
sub admin_setup {
|
|
# ------------------------------------------------------------------
|
|
# Set the configuration.
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $cgi = $IN->get_hash();
|
|
|
|
if ( $cgi->{pg} eq 'admin_setup_misc.html' and (($cgi->{mail_path} and $cgi->{smtp_server}) or (!$cgi->{smtp_server} and !$cgi->{mail_path})) ) {
|
|
return admin_setup_form(GList::language('SET_MISC_ERR'));
|
|
}
|
|
|
|
if ( !$cgi->{brestore} and exists $cgi->{cgi_url} and exists $cgi->{priv_path} and exists $cgi->{image_url} and
|
|
( !$cgi->{cgi_url} or !$cgi->{priv_path} or !$cgi->{image_url} ) ) {
|
|
return admin_setup_form(GList::language('SET_PATH_ERR'));
|
|
}
|
|
|
|
if ($cgi->{brestore}) {
|
|
$CFG->default_path (1);
|
|
}
|
|
else {
|
|
_update_cfg();
|
|
}
|
|
$CFG->save();
|
|
return admin_setup_form(GList::language('SET_CFG_SUCCESS'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_template_diff} = <<'END_OF_SUB';
|
|
sub admin_template_diff {
|
|
# ------------------------------------------------------------------
|
|
# Load fileman, but just for the purposes of displaying a diff.
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
require GT::FileMan;
|
|
my $fileman = GT::FileMan->new(
|
|
cfg => {
|
|
template_root => "$CFG->{priv_path}/templates/common",
|
|
root_dir => "$CFG->{priv_path}/templates",
|
|
html_root_url => $CFG->{image_url}. '/fileman',
|
|
debug_level => 0,
|
|
winnt => $^O eq 'MSWin32' ? 1 : 0,
|
|
command_time_out => 20,
|
|
allowed_space => 0,
|
|
},
|
|
url_opts => 'do=fileman_diff'
|
|
);
|
|
$fileman->process();exit;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{init_setup} = __LINE__ . <<'END_OF_SUB';
|
|
sub init_setup {
|
|
# ------------------------------------------------------------------
|
|
# Sets the mysql information.
|
|
#
|
|
my ($host, $port, $overwrite);
|
|
# Test the ability to create a def file.
|
|
|
|
unless (open (TEST, "> $CFG->{priv_path}/defs/database.def")) {
|
|
return GList::display('setup_second.html', {
|
|
error => "Unable to create our def file in $CFG->{priv_path}/defs/. <br>\n
|
|
Please make sure this directory exists, and is writeable by the server. <br>\n
|
|
If this is the wrong directory, you will need to manually set the directory <br>\n
|
|
in GList::ConfigData. Error was: $!"
|
|
});
|
|
}
|
|
close TEST;
|
|
unlink "$CFG->{priv_path}/defs/database.def";
|
|
|
|
# Set the connection info.
|
|
$overwrite = $IN->param('overwrite') ? 'force' : 'check';
|
|
$host = $IN->param('host');
|
|
($host =~ s/\:(\d+)$//) and ($port = $1);
|
|
|
|
my $prefix = $IN->param('prefix');
|
|
$prefix =~ /^\w*$/ or return GList::display('setup_second.html', { error => "Invalid prefix: '$prefix'. Can only be letters, numbers and underscore." });
|
|
|
|
$DB->prefix($prefix);
|
|
my $ret = $DB->set_connect ({
|
|
driver => scalar $IN->param('driver'),
|
|
host => $host,
|
|
port => $port,
|
|
database => scalar $IN->param('database'),
|
|
login => scalar $IN->param('login'),
|
|
password => scalar $IN->param('password'),
|
|
RaiseError => 0,
|
|
PrintError => 0,
|
|
AutoCommit => 1
|
|
});
|
|
if (! defined $ret) {
|
|
return GList::display('setup_second.html', { error => $GT::SQL::error });
|
|
}
|
|
# Now let's create the tables.
|
|
eval { local $SIG{__DIE__}; require GList::SQL; };
|
|
if ($@) { return GList::display('setup_second.html', { error => "Unable to load Dbsql::SQL module: $@\n" }); }
|
|
|
|
my $output = GList::SQL::tables($overwrite);
|
|
|
|
# Add admin user
|
|
my $db = $DB->table('Users');
|
|
$db->insert({
|
|
usr_email => $IN->param('admin_user'),
|
|
usr_password => $IN->param('admin_pass'),
|
|
usr_type => ADMINISTRATOR,
|
|
usr_reply_email => $IN->param('admin_user'),
|
|
usr_bounce_Email => $IN->param('admin_user')
|
|
});
|
|
if ( $GT::SQL::error ) {
|
|
return GList::display('setup_second.html', { error => $GT::SQL::error });
|
|
}
|
|
|
|
# And lets set sensible defaults for the rest of the config vars.
|
|
$CFG->create_defaults();
|
|
|
|
# And save the config.
|
|
$CFG->save();
|
|
|
|
GList::display('setup_third.html', { message => "The data tables have been setup: <pre>$output</pre>" } );
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_table} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_table {
|
|
#--------------------------------------------------------------------
|
|
# Load Users table properties
|
|
#
|
|
my $msg = shift;
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $db_usr = $DB->table('Users');
|
|
my $cols = $db_usr->cols;
|
|
my $pro_cols = [ grep(/^pro_/, $db_usr->ordered_columns) ];
|
|
|
|
my @output;
|
|
foreach my $c ( @$pro_cols ) {
|
|
$cols->{$c}->{name} = $c;
|
|
push @output, $cols->{$c};
|
|
}
|
|
|
|
return ('admin_user_table.html', { loop_fields => \@output, msg => $msg });
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_table_add} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_table_add {
|
|
#-------------------------------------------------------------
|
|
# Add a field
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
return ('admin_user_table_add.html') if ($IN->param('form'));
|
|
|
|
my $db = $DB->table('Users');
|
|
my %cols = $db->cols;
|
|
my $attribs = _col_spec();
|
|
my $column = 'pro_'.$IN->param('column');
|
|
|
|
# Error checking
|
|
my $errors = _field_check();
|
|
if ( exists $cols{$column} ) {
|
|
$errors .= sprintf(GList::language('TAB_COL_EXISTS'), $column);
|
|
}
|
|
if ( $IN->param('index') eq 'primary' ) {
|
|
$errors .= GList::language('TAB_PRIMARY_ERR');
|
|
}
|
|
return ('admin_user_table_add.html', { msg => "<font color=red><b>$errors</b></font>" }) if ($errors);
|
|
|
|
$attribs->{pos} = keys(%cols) + 1;
|
|
$attribs->{edit} = 1;
|
|
$attribs->{default} ||= '';
|
|
my $editor = $DB->editor('Users');
|
|
|
|
# Add the column.
|
|
delete $attribs->{column};
|
|
$editor->add_col($column, $attribs) or return ('admin_user_table_add.html', { msg => GList::language('TAB_ADD_COLUMN_ERR', $column, $GT::SQL::error) });
|
|
|
|
# Add the indexes.
|
|
if ( $IN->param('index') eq 'regular' ) {
|
|
$editor->add_index($column . '_idx' => [$column]) or return ('admin_user_table_add.html', { msg => GList::language('TAB_ADD_INDEX_ERR', $GT::SQL::error) });
|
|
}
|
|
if ( $IN->param('index') eq 'unique' ) {
|
|
$editor->add_index($column . '_idx' => [$column]) or return ('admin_user_table_add.html', { msg => GList::language('TAB_ADD_UNIQUE_ERR', $GT::SQL::error) });
|
|
}
|
|
$db->reload;
|
|
|
|
return admin_user_table(GList::language('TAB_ADD_SUCCESS', $column));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_table_modify} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_table_modify {
|
|
#-------------------------------------------------------------
|
|
# Modify a field
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $col = $IN->param('column');
|
|
my $db = $DB->table('Users');
|
|
my $editor = $DB->editor('Users');
|
|
my $cols = $db->cols;
|
|
my $old_def = $cols->{$col};
|
|
return admin_user_table(GList::language('TAB_MOD_ERR', $col)) if (!exists $cols->{$col} or !$col);
|
|
|
|
my %attribs = %{$cols->{$col}};
|
|
|
|
# Set up defaults for the fields
|
|
foreach my $col (qw/column type not_null file_save_in file_max_size file_save_scheme default form_display form_type form_size form_names form_values regex weight values size/) {
|
|
$attribs{$col} = $IN->param($col) if ( defined $IN->param($col) );
|
|
}
|
|
|
|
$attribs{column} ||= $col;
|
|
$attribs{form_type} ||= 'TEXT';
|
|
$attribs{form_size} ||= ($attribs{form_type} eq 'SELECT') ? 0 : '';
|
|
ref $attribs{form_size} and ($attribs{form_size} = join(",", @{$attribs{form_size}}));
|
|
ref $attribs{form_names} and ($attribs{form_names} = join("\n", @{$attribs{form_names}}));
|
|
ref $attribs{form_values} and ($attribs{form_values} = join("\n", @{$attribs{form_values}}));
|
|
ref $attribs{values} and ($attribs{values} = join("\n", @{$attribs{values}}));
|
|
return ('admin_user_table_modify.html', \%attribs) if ($IN->param('form'));
|
|
|
|
# Keep any values that where there before
|
|
my $attribs = _col_spec();
|
|
for my $val ( keys %$old_def ) {
|
|
$attribs->{$val} = $old_def->{$val} unless exists $attribs->{$val};
|
|
}
|
|
|
|
# Error checking
|
|
my $errors = _field_check();
|
|
if ( $IN->param('index') eq 'primary' and ( $col ne $db->{schema}->{pk}) ) {
|
|
$errors .= GList::language('TAB_PRIMARY_ERR');
|
|
}
|
|
return ('admin_user_table_modify.html', { msg => "<font color=red><b>$errors</b></font>", %attribs }) if($errors);
|
|
|
|
# Add/Drop indexes.
|
|
my $index_type = _index_type($col);
|
|
if ( $index_type ne $IN->param('index') ) {
|
|
if ($index_type eq 'none') {
|
|
if ( $IN->param('index') eq 'regular' ) {
|
|
$editor->add_index( $col . "_idx" => [$col] );
|
|
}
|
|
else {
|
|
$editor->add_unique( $col . "_idx" => [$col] );
|
|
}
|
|
}
|
|
elsif ( $IN->param('index') eq 'none' ) {
|
|
if ( $index_type eq 'regular' ) {
|
|
my $index = $db->index;
|
|
INDEX: foreach my $index_name (keys %$index) {
|
|
foreach my $col_name ( @{$index->{$index_name}} ) {
|
|
next unless ($col_name eq $col);
|
|
$editor->drop_index($index_name) or return ('admin_user_table_modify.html', { msg => "<font color=red><b>$GT::SQL::error</b></font>", %attribs });
|
|
last INDEX;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
my $unique = $db->unique;
|
|
INDEX: foreach my $unique_name (keys %$unique) {
|
|
foreach my $col_name (@{$unique->{$unique_name}}) {
|
|
next unless ($col_name eq $col);
|
|
$editor->drop_unique($unique_name) or return ('admin_user_table_modify.html', { msg => "<font color=red><b>$GT::SQL::error</b></font>", %attribs });
|
|
last INDEX;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Make the changes
|
|
delete $attribs->{column};
|
|
|
|
$editor->alter_col($col, $attribs) or return ('admin_user_table_modify.html', { msg => '<font color=red><b>'.$editor->error.'</b></font>', %attribs });
|
|
return admin_user_table(GList::language('TAB_MOD_SUCCESS', $col));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_table_delete} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_table_delete {
|
|
#--------------------------------------------------------------
|
|
# Delete a field of User Table
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
#------------demo code-----------
|
|
|
|
my $column = $IN->param('column');
|
|
return admin_user_table(GList::language('TAB_MOD_INVALID')) if (!$column);
|
|
return admin_user_table(GList::language('TAB_MOD_PERMIT_ERR', 'pro_first_name, pro_last_name')) if ($column =~ /pro_first_name|pro_last_name/);
|
|
|
|
# Keep any values that where there before
|
|
my $db = $DB->table('Users');
|
|
my $editor = $DB->editor('Users');
|
|
my $old_def = $db->cols->{$column};
|
|
|
|
# Drop the column from the database.
|
|
$editor->drop_col($column) or return admin_user_table("<font color=red><b>$GT::SQL::error</b></font>");
|
|
|
|
return admin_user_table(GList::language('TAB_DEL_SUCCESS', $column));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_user_table_resync} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_user_table_resync {
|
|
#--------------------------------------------------------------------
|
|
# Resync database
|
|
#
|
|
my $name = $IN->param('db') || 'Users';
|
|
$USER->{usr_type} == ADMINISTRATOR or return ('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
# We need a creator for this.
|
|
my $c = $DB->creator($name);
|
|
my $db = $DB->table($name);
|
|
$c->load_table or return admin_user_table($GT::SQL::error);
|
|
|
|
# Re Load our table object.
|
|
$db->reload;
|
|
|
|
return admin_user_table(GList::language('TAB_RESYNC'));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_stoplist} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_stoplist {
|
|
#-------------------------------------------------------------------
|
|
# Update the stop lists
|
|
#
|
|
my $msg = shift;
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
$MN_SELECTED = 9;
|
|
return ('admin_stoplist_form.html') if ($IN->param('form'));
|
|
|
|
my $alpha = 0;
|
|
my $cgi = $IN->get_hash;
|
|
my $query= '';
|
|
if ($IN->param('alpha') and $IN->param('alpha') ne 'all') { # from the quick search bar
|
|
$alpha = $IN->param('alpha');
|
|
$query = "alpha=$alpha";
|
|
}
|
|
my $db = $DB->table('StopLists');
|
|
$db->select_options('ORDER BY letter');
|
|
|
|
require GT::SQL::Condition;
|
|
my $cd = GT::SQL::Condition->new();
|
|
my $url = 'glist.cgi?do=admin_stoplist';
|
|
if ($cgi->{stl_email}) {
|
|
$cd->add('stl_email' => 'like' => "%$cgi->{stl_email}%");
|
|
$url .= ";stl_email=$cgi->{stl_email}";
|
|
}
|
|
|
|
my $sth = $db->select($cd, ['DISTINCT SUBSTRING(stl_email, 1, 1) as letter']);
|
|
my $results = GList::search(
|
|
cgi => $cgi,
|
|
db => $DB->table('StopLists'),
|
|
based_on => $DB->prefix.'StopLists',
|
|
prefix => 'stl',
|
|
sb => 'stl_email',
|
|
so => 'ASC',
|
|
search_alpha=> $alpha,
|
|
search_col => 'stl_email',
|
|
return_msg => 'ADM_STOPLIST',
|
|
skip_user => 1,
|
|
);
|
|
|
|
require GList::List;
|
|
if ( ref $results ne 'HASH' ) {
|
|
return ('admin_stoplist.html', { search_bar => GList::List::_search_bar($sth, $url), msg => $results });
|
|
}
|
|
$results->{msg} = $msg if ($msg);
|
|
return ('admin_stoplist.html', { search_bar => GList::List::_search_bar($sth, $url), toolbar_query => $query, toolbar_table => 'StopLists', %$results })
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_stoplist_confirm} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_stoplist_confirm {
|
|
#--------------------------------------------------------------------
|
|
# Confirmation about remove all emails that match the addition stoplist
|
|
# from all list
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
$MN_SELECTED = 9;
|
|
my $emails = $IN->param('emails') || '';
|
|
return ('lst_stoplist_form.html', { msg => GList::language('ADM_STOPLIST_ERROR') }) if (!$emails);
|
|
|
|
require GT::SQL::Condition;
|
|
my $db_sub = $DB->table('Subscribers');
|
|
my @emails = split(/\r?\n/, $emails);
|
|
|
|
my (@results, %found);
|
|
foreach my $e (@emails) {
|
|
$e =~ s/^\s+//;
|
|
$e =~ s/\s+$//;
|
|
next unless $e and $e =~ /.@./;
|
|
my $cond;
|
|
if ($e =~ /[*?]/) {
|
|
my $tmp = $e;
|
|
$tmp =~ y/*/%/;
|
|
$tmp =~ y/?/_/;
|
|
$cond = GT::SQL::Condition->new(sub_email => LIKE => $tmp);
|
|
}
|
|
else {
|
|
$cond = { sub_email => $e };
|
|
}
|
|
my $pre = keys %found;
|
|
my @found = $db_sub->select(sub_id => $cond)->fetchall_list;
|
|
for (@found) { $found{$_}++ }
|
|
my $added = keys(%found) - $pre;
|
|
push @results, { email => $e, found => $added };
|
|
}
|
|
|
|
my $found_emails = scalar keys %found;
|
|
return admin_stoplist_add() if (!$found_emails);
|
|
|
|
return ('admin_stoplist_form.html', {
|
|
loop_results => \@results,
|
|
loop_hits => $#results + 1,
|
|
found_emails => $found_emails,
|
|
data => $emails,
|
|
confirmation => 1
|
|
});
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_stoplist_add} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_stoplist_add {
|
|
#--------------------------------------------------------------------
|
|
# Add email to stop list
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
$MN_SELECTED = 9;
|
|
my $emails = $IN->param('emails') || '';
|
|
return ('lst_stoplist_form.html', { msg => GList::language('ADM_STOPLIST_ERROR') }) if (!$emails);
|
|
|
|
my ($invalid, $duplicate) = (0, 0);
|
|
my @emails = split(/\r?\n/, $emails);
|
|
my $db_stl = $DB->table('StopLists');
|
|
my $db_sub = $DB->table('Subscribers');
|
|
|
|
require GT::SQL::Condition;
|
|
my @results;
|
|
my $cond = GT::SQL::Condition->new('OR');
|
|
foreach my $e (@emails) {
|
|
$e =~ s/^\s+//;
|
|
$e =~ s/\s+$//;
|
|
next if !$e;
|
|
if ( $e !~ /.@./ ) { # check email address
|
|
push @results, { email => $e, status => GList::language('SYS_INVALID_EMAIL') };
|
|
$invalid++;
|
|
}
|
|
else {
|
|
if ($e =~ /[*?]/) {
|
|
my $tmp = $e;
|
|
$tmp =~ y/*/%/;
|
|
$tmp =~ y/?/_/;
|
|
$cond->add(sub_email => LIKE => $tmp);
|
|
}
|
|
else {
|
|
$cond->add(sub_email => '=' => $e);
|
|
}
|
|
|
|
push @results, { email => $e, status => '' };
|
|
if ($db_stl->count({ stl_email => $e })) {
|
|
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
|
$duplicate++;
|
|
}
|
|
else {
|
|
$db_stl->insert({ stl_email => $e });
|
|
}
|
|
}
|
|
}
|
|
$db_sub->delete($cond) if (@{$cond->{cond}});
|
|
|
|
return ('admin_stoplist_success.html', {
|
|
results => \@results,
|
|
duplicate => $duplicate,
|
|
invalid => $invalid,
|
|
hits => scalar @results,
|
|
successful => scalar @results - $invalid - $duplicate,
|
|
});
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{admin_stoplist_delete} = __LINE__ . <<'END_OF_SUB';
|
|
sub admin_stoplist_delete {
|
|
#---------------------------------------------------------------------
|
|
# Delete email from stop list
|
|
#
|
|
$USER->{usr_type} == ADMINISTRATOR or return GList::display('error_form.html', { msg => GList::language('ADM_PERMISSION_ERR') });
|
|
|
|
my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
|
|
my $db = $DB->table('StopLists');
|
|
my $cgi = $IN->get_hash();
|
|
|
|
foreach my $rec_num ( @{$mod} ) {
|
|
$db->delete({ stl_id => $cgi->{"$rec_num-stl_id"} });
|
|
}
|
|
return admin_stoplist(GList::language('ADM_STOPLIST_DELETED', $#$mod + 1));
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_update_cfg} = __LINE__ . <<'END_OF_SUB';
|
|
sub _update_cfg {
|
|
# ------------------------------------------------------------------
|
|
# Updates the config based on the form input.
|
|
#
|
|
foreach my $param ($IN->param) {
|
|
if (exists $CFG->{$param}) {
|
|
if (ref $CFG->{$param} eq ref []) {
|
|
my @val = split /\s*,\s*/, $IN->param($param);
|
|
$CFG->{$param} = \@val;
|
|
}
|
|
elsif (ref $CFG->{$param} eq ref {}) {
|
|
my $h = {};
|
|
my @pairs = split /\s*,\s*/, $IN->param($param);
|
|
foreach my $pair (@pairs) {
|
|
my ($k, $v) = split /\s*=\s*/, $pair;
|
|
$h->{$k} = $v;
|
|
}
|
|
$CFG->{$param} = $h;
|
|
}
|
|
else {
|
|
$CFG->{$param} = $IN->param($param);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_field_check} = __LINE__ . <<'END_OF_SUB';
|
|
sub _field_check {
|
|
# ----------------------------------------------------------
|
|
# Checks to see if the input field name is a valid one,
|
|
# the function checks the following:
|
|
# 1. Column name
|
|
# 2. Check column exist
|
|
# 3. Check field size
|
|
my $cgi = $IN->get_hash;
|
|
my $col_name = $cgi->{column} || $cgi->{mod};
|
|
my $form_type = uc($cgi->{form_type});
|
|
my $type = uc($cgi->{type});
|
|
|
|
return GList::language('TAB_COL_NAME') if ( $col_name !~ /^(\w+)$/ );
|
|
|
|
# Max lengths
|
|
if (( $type eq 'CHAR' ) and ( $cgi->{size} > 255 ) ) {
|
|
return GList::language('TAB_COL_SIZE');
|
|
}
|
|
|
|
if ( ( $type eq 'INT' ) and ( $cgi->{size} > 0 ) ) {
|
|
return GList::language('TAB_COL_SIZE_INT');
|
|
}
|
|
|
|
if ( ( $type eq 'ENUM' ) and ( !$cgi->{values} ) ) {
|
|
return GList::language('TAB_COL_VALUES');
|
|
}
|
|
|
|
if ( ( $cgi->{index} eq 'primary' or $cgi->{index} eq 'index' or $cgi->{index} eq 'unique' ) and ( ! $cgi->{not_null} ) ) {
|
|
return sprintf(GList::language('TAB_COL_NOTNULL'), $col_name);
|
|
}
|
|
|
|
if ( ( $form_type eq 'FILE' ) and ( $type ne 'CHAR' ) and ( $type ne 'VARCHAR' ) ) {
|
|
return GList::language('TAB_COL_FILE_TYPE');
|
|
}
|
|
|
|
my $location = $cgi->{file_save_in};
|
|
if ( ( $form_type eq 'FILE' ) and ( !$location ) ) {
|
|
return GList::language('TAB_COL_FILE_IN');
|
|
}
|
|
|
|
if ( ( $form_type eq 'FILE' ) and ( !-w $location ) ) {
|
|
return sprintf(GList::language('TAB_COL_FILE_ERR'), $location);
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_col_spec} = __LINE__ . <<'END_OF_SUB';
|
|
sub _col_spec {
|
|
# ----------------------------------------------------------
|
|
# Reconstruct the input variables into a string in the form
|
|
# "field_name(type(length_set) attribute DEFAULT default_value extra)"
|
|
|
|
my $cgi = $IN->get_hash;
|
|
my $col_spec;
|
|
|
|
# add field properties into a hash
|
|
$col_spec->{'type'} = $cgi->{type};
|
|
if ( $cgi->{type} eq 'ENUM' ) {
|
|
$col_spec->{'values'} = [split /(?:\n|\r)+/, $cgi->{values}];
|
|
}
|
|
else {
|
|
$col_spec->{'size'} = $cgi->{size};
|
|
}
|
|
$col_spec->{'default'} = $cgi->{default};
|
|
$col_spec->{'not_null'} = ($cgi->{not_null}) ? '1' : '';
|
|
$col_spec->{'form_display'} = ($cgi->{form_display})? $cgi->{form_display} : $cgi->{column};
|
|
$col_spec->{'form_type'} = ($cgi->{form_type}) ? $cgi->{form_type} : 'TEXT';
|
|
$col_spec->{'form_size'} = ($cgi->{form_size}) ? $cgi->{form_size} : '';
|
|
$col_spec->{'form_names'} = ($cgi->{form_names}) ? [split /(?:\n|\r)+/, $cgi->{form_names}] : [];
|
|
$col_spec->{'form_values'} = ($cgi->{form_values}) ? [split /(?:\n|\r)+/, $cgi->{form_values}]: [];
|
|
$col_spec->{'regex'} = ($cgi->{regex}) ? $cgi->{regex} : '';
|
|
|
|
if ( $cgi->{file_save_in} ) {
|
|
$col_spec->{'file_save_in'} = $cgi->{file_save_in};
|
|
$col_spec->{'file_save_scheme'} = $cgi->{file_save_scheme};
|
|
$col_spec->{'file_max_size'} = $cgi->{file_max_size};
|
|
}
|
|
|
|
return $col_spec;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_index_type} = __LINE__ . <<'END_OF_SUB';
|
|
sub _index_type {
|
|
#-----------------------------------------------------------------
|
|
my $column = shift;
|
|
my $db = $DB->table('Users');
|
|
my $indexed = 'none';
|
|
if ($column) {
|
|
$db->_is_indexed($column) and ($indexed = 'regular');
|
|
$db->_is_unique($column) and ($indexed = 'unique');
|
|
$db->_is_pk($column) and ($indexed = 'primary');
|
|
}
|
|
return $indexed;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_save_users} = __LINE__ . <<'END_OF_SUB';
|
|
sub _save_users {
|
|
#-------------------------------------------------------------------
|
|
#
|
|
my $users = $DB->table('Users')->select({ usr_type => ADMINISTRATOR }, ['usr_username', 'usr_password', 'usr_email'])->fetchall_hashref;
|
|
my %hash;
|
|
foreach (@$users) {
|
|
$hash{$_->{usr_username}} = [$_->{usr_password}, $_->{usr_email}];
|
|
}
|
|
$CFG->{admin} = \%hash;
|
|
$CFG->save;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_sql_load_cfg} = __LINE__ . <<'END_OF_SUB';
|
|
sub _sql_load_cfg {
|
|
#-------------------------------------------------------------------
|
|
# Load current sql information
|
|
#
|
|
require GList::SQL;
|
|
my $cfg = GList::SQL::load();
|
|
foreach (keys % $cfg) {
|
|
$cfg->{"sql_$_"} = $cfg->{$_};
|
|
delete $cfg->{$_};
|
|
}
|
|
return $cfg;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_sql_connect} = __LINE__ . <<'END_OF_SUB';
|
|
sub _sql_connect {
|
|
#----------------------------------------------------------
|
|
#
|
|
my ($host, $driver, $database, $login, $password, $prefix) = @_;
|
|
|
|
my ($port, $ret);
|
|
($host =~ s/\:(\d+)$//) and ($port = $1);
|
|
|
|
$prefix =~ /^\w*$/ or return { error => "<font color=red><b>Invalid prefix: '$prefix'. Can only be letters, numbers and underscore.</b></font>" };
|
|
|
|
GT::SQL->reset_env();
|
|
$DB->prefix($prefix);
|
|
$ret = $DB->set_connect({
|
|
driver => $driver,
|
|
host => $host,
|
|
port => $port,
|
|
database => $database,
|
|
login => $login,
|
|
password => $password,
|
|
RaiseError => 0,
|
|
PrintError => 0,
|
|
AutoCommit => 1
|
|
});
|
|
|
|
if (! defined $ret) {
|
|
return { error => "<font color=red><b>$GT::SQL::error</b></font>" };
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_account_limit} = __LINE__ . <<'END_OF_SUB';
|
|
sub _account_limit {
|
|
#-----------------------------------------------------------
|
|
#
|
|
my $data = shift;
|
|
if ($data->{usr_type} == ADMINISTRATOR or $data->{usr_type} == UNLIMITED_USER ) {
|
|
$data->{usr_limit_list} = 0;
|
|
$data->{usr_limit_sublist} = 0;
|
|
$data->{usr_limit_email30} = 0;
|
|
}
|
|
else {
|
|
$data->{usr_limit_list} ||= $CFG->{signup_limit_list} || 10;
|
|
$data->{usr_limit_sublist} ||= $CFG->{signup_limit_sublist} || 10;
|
|
$data->{usr_limit_email30} ||= $CFG->{signup_limit_email30} || 100;
|
|
}
|
|
return $data;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
|
sub _determine_action {
|
|
#----------------------------------------------------------------------------
|
|
# Check valid action
|
|
#
|
|
my $action = shift || undef;
|
|
|
|
if ( $action =~ /admin_setup_sql_form|admin_setup_sql|admin_setup_form|admin_setup/ ) {
|
|
$MN_SELECTED = 9;
|
|
}
|
|
($action eq 'admin_user_search') and return 'admin_user';
|
|
return if ( !$action );
|
|
|
|
my %valid = (
|
|
map { $_ => 1 } qw(
|
|
admin_gtdoc
|
|
admin_page
|
|
admin_initial_sql
|
|
admin_initial_setup
|
|
admin_user
|
|
admin_user_add
|
|
admin_user_modify_form
|
|
admin_user_modify
|
|
admin_user_delete
|
|
admin_user_validate
|
|
admin_user_table
|
|
admin_user_table_add
|
|
admin_user_table_modify
|
|
admin_user_table_delete
|
|
admin_user_table_resync
|
|
admin_plugin
|
|
admin_setup_sql_form
|
|
admin_setup_sql
|
|
admin_setup_form
|
|
admin_setup
|
|
admin_template_diff
|
|
admin_stoplist
|
|
admin_stoplist_add
|
|
admin_stoplist_confirm
|
|
admin_stoplist_delete
|
|
)
|
|
);
|
|
exists $valid{$action} and return $action;
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
1;
|