# ==================================================================
# Gossamer Community
#
# Website : http://gossamer-threads.com/
# Support : http://gossamer-threads.com/scripts/support/
# CVS Info :
# Revision : $Id: Admin.pm,v 1.65 2003/05/31 23:26:30 aki Exp $
#
# Copyright (c) 2002 Gossamer Threads Inc. All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
package Community::Web::Admin;
# ===================================================================
use strict 'vars', 'subs';
use GT::Base qw/:all/;
use Community qw/
$IN $DB $CFG
comm_encrypt
comm_compare_pass
comm_language
comm_fatal
comm_debug
/;
use GT::Plugins;
sub process {
# -------------------------------------------------------------------
my $do = shift;
# Check that the IP the user coming from is allowed to access the admin area.
if (@{$CFG->{admin_ips}}) {
my $ip = $ENV{REMOTE_ADDR};
unless (grep { $ip eq $_ } @{$CFG->{admin_ips}}) {
print $IN->header;
require Community::Web::User;
return Community::Web::User::user_page('user_login.html', { error => comm_language('LOGIN_BANNEDIP') });
}
}
my %valid = (
map { $_ => 1 } qw(
admin_home
admin_help
admin_user
admin_user_form
admin_user_add
admin_user_mod
admin_user_del
admin_verify
admin_import
admin_export
admin_sql
admin_online
admin_setup
admin_setup_sql
admin_setup_pwd
admin_env
admin_logout
admin_initial_setup
admin_database_resync
admin_database_editor
admin_database_column_add
admin_database_column_editor
admin_database_column_modify
admin_database_column_delete
admin_apps
admin_apps_add
admin_apps_form
admin_apps_modify
admin_apps_delete
admin_apps_users
admin_view_file
admin_download_file
admin_plugin
)
);
$do = exists $valid{$do} ? $do : 'admin_home';
admin_date_init();
my ($tpl, $vars, $opts, $cookies) = GT::Plugins->dispatch(
$CFG->{path_private} . '/lib/Plugins/Community',
"web_$do",
\&$do,
@_
);
if ($tpl) {
return GT::Plugins->dispatch(
$CFG->{path_private} . '/lib/Plugins/Community',
'web_admin_page',
\&admin_page,
$tpl, $vars, $opts, $cookies
);
}
}
sub admin_home {
# -------------------------------------------------------------------
my $pg = $IN->param('pg') || 'admin_home.html';
return $pg;
}
sub admin_page {
# -------------------------------------------------------------------
my ( $page, $vars, $opts, $cookies ) = @_;
$page ||= 'admin_home.html';
if ($page !~ /^[\w\-]+\.[\w\-]+$/) {
die "Invalid page: $page\n";
$page = 'admin_home.html';
}
my $template_dir = "$CFG->{path_private}/templates/$CFG->{system_template_set}";
$vars ||= {};
$opts ||= {};
exists $opts->{compress} or ($opts->{compress} = $CFG->{system_compress});
exists $opts->{print} or ($opts->{print} = 1);
exists $opts->{escape} or ($opts->{escape} = 1);
exists $opts->{root} or ($opts->{root} = $template_dir);
# Used for menu to show if we are logged in.
$vars->{comm_admin} = $IN->cookie('Community_Admin_Pass') unless (exists $vars->{comm_admin});
# Add version number which gets displayed on footer.
$vars->{comm_version} = $CFG->{version};
# Add config vars.
foreach my $key (keys %$CFG) {
$vars->{$key} = $CFG->{$key} unless (exists $vars->{$key});
}
# Add globals
my $globals = GT::Config->load($template_dir . '/globals.txt', {
local => 1,
cache => 1,
inheritance => 1,
create_ok => 1,
compile_subs => 'Community::Web::Admin'
});
foreach my $global (keys %$globals) {
unless (exists $vars->{$global}) {
$vars->{$global} = ref $globals->{$global} ?
$globals->{$global} :
\$globals->{$global};
}
}
# Used for HTML editor.
my $version;
if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} =~ /MSIE (\d+(?:\.\d+)?)/) {
$version = $1;
}
$vars->{is_ie} = $version && $version >= 5.5;
if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} =~ m{Mozilla/(\d+\.\d+)}) {
$version = $1;
}
$vars->{is_mozilla5} = $version && $version >= 5;
# Make CGI input available.
foreach my $key ($IN->param) {
$vars->{$key} = $IN->param($key) unless (exists $vars->{$key});
}
print $IN->header( $cookies ? ( -cookie => $cookies ) : () ) if $opts->{print};
GT::Template->parse($page, $vars, $opts);
}
sub admin_date_init {
#--------------------------------------------------------------------
require GT::Date;
$GT::Date::OFFSET = $CFG->{date_offset} * 3600;
$GT::Date::LANGUAGE = {
'month_names' => $CFG->{date_month_long},
'day_names' => $CFG->{date_days_long},
'short_month_names' => $CFG->{date_month_short},
'short_day_names' => $CFG->{date_days_short}
};
GT::Date::build_lang();
}
sub admin_user {
#--------------------------------------------------------------------
my $msg = shift;
my $cgi = $IN->get_hash();
my $mh = $cgi->{mh} || $CFG->{admin_page_per_screen} || 25;
my $nh = $cgi->{nh} || 1;
my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh; # started record
my $sb = $cgi->{sb} || 'comm_username';
my $so = $cgi->{so} || 'ASC';
my $al = $cgi->{alpha};
require GT::SQL::Condition;
my $cd = new GT::SQL::Condition;
my $db = $DB->table('comm_users');
my (@results, $speed_bar, $error);
if ( $cgi->{bsearch} ) { # search users
if ( !$cgi->{search_val} ) {
$error = comm_language('ADMIN_USER_SRC_INVALID');
}
elsif ( $cgi->{search_val} ne '*' ) {
if ( $cgi->{search_col} ) { # search on specified field
$cd->add($cgi->{search_col}, 'like', "%$cgi->{search_val}%");
}
else { # all fields
my @cols = qw/comm_username comm_email prof_first_name prof_last_name prof_company prof_country prof_state prof_city prof_phone/;
my $cd_sub = new GT::SQL::Condition('OR');
foreach ( @cols ) {
next unless (exists $db->cols->{$_});
$cd_sub->add($_, 'like', "%$cgi->{search_val}%");
}
$cd->add($cd_sub);
}
$msg = comm_language('ADMIN_USER_SRC_RESULTS');
}
}
elsif ( $al and $al ne 'all') { # quick search users
$cd->add('comm_username', 'like', "$al%");
$msg = comm_language('ADMIN_USER_SRC_RESULTS');
}
my $hits = $db->count($cd);
$msg ||= comm_language('ADMIN_USER_RESULTS');
$msg = sprintf($msg, $hits);
if ( $hits ) {
$db->select_options("ORDER BY $sb $so", "LIMIT $bg, $mh");
my $sth = $db->select($cd);
while ( my $rs = $sth->fetchrow_hashref ) {
push @results, $rs;
}
if ( $hits > $mh ) {
my $url = GT::CGI->url(remove_empty => 1);
my $disp = $DB->html($db, $cgi);
$speed_bar .= $disp->toolbar($nh, $mh, $hits, $url);
}
}
my $search_bar = _search_bar();
return ('admin_user.html', {
hits => $hits,
speed_bar => \$speed_bar,
results => \@results,
search_bar => \$search_bar,
msg => \$msg,
error => \$error
});
}
sub admin_user_form {
#--------------------------------------------------------------------
my $error = shift;
my @questions;
foreach my $question ( @{$CFG->{signup_questions}} ) {
push @questions, { question => $question };
}
my $app_hits = $DB->table('comm_apps')->count;
my $enctype = $DB->table('comm_users')->_file_cols() ? 'enctype="multipart/form-data"' : '';
# Display the modify form if we have a community id already.
if ($IN->param('comm_id')) {
my $user = $DB->table('comm_users')->get($IN->param('comm_id'));
if (! $user) {
return admin_user(comm_language('ADMIN_USER_MOD_INVALID', $IN->param('comm_id')))
}
$user = _user_from_cgi($IN->get_hash, $user, $error ? 1 : 0);
return ('admin_user_modify_form.html', {
comm_question_loop => \@questions,
apps_hits => $app_hits,
enctype => $enctype,
error => \$error,
%$user,
});
}
# Otherwise, display the add form.
else {
my %apps;
# If this is pulling up the form for the first time, make sure to default which
# apps are going to be active.
if ($IN->param('do') eq 'admin_user_form') {
my $apps = $DB->table('comm_apps')->select->fetchall_hashref;
foreach my $app (@$apps) {
$apps{'app_' . $app->{app_keyword}} = $app->{app_autocreate} ? 2 : 0;
}
}
my $enabled = defined $IN->param('comm_enabled') ? $IN->param('comm_enabled') : 1;
return ('admin_user_add_form.html', {
comm_question_loop => \@questions,
comm_enabled => $enabled,
apps_hits => $app_hits,
enctype => $enctype,
error => \$error,
%apps
});
}
}
sub admin_user_add {
#--------------------------------------------------------------------
my $db = $DB->table('comm_users');
my $cols = $db->cols;
my $user = _user_from_cgi($IN->get_hash);
require Community::User;
my $error;
$error = Community::User::cuser_un_validate_error($user->{comm_username});
if ($error) {
return admin_user_form(comm_language($error, $user->{comm_username}));
}
$error = Community::User::cuser_email_validate_error($user->{comm_email});
if ($error) {
return admin_user_form(comm_language($error, $user->{comm_email}));
}
unless ( $user->{comm_password} ) {
return admin_user_form(comm_language('ADMIN_INVALID_PASSWORD'));
}
my $clear_pass = $user->{comm_password};
$clear_pass =~ s/^\s*|\s*$//g;
if ( $CFG->{system_store_clear_pass} ) {
$user->{comm_clr_pass} = $clear_pass;
}
$user->{comm_password} = comm_encrypt($clear_pass);
$user->{comm_created} = time;
$user->{comm_email_val} = 1;
local $GT::SQL::ERRORS->{ILLEGALVAL} = comm_language('ADMIN_DB_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = comm_language('ADMIN_DB_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = comm_language('ADMIN_DB_NOTNULL');
my $comm_id = Community::User::cuser_insert($user);
if (! $comm_id) {
my $error_msg = $Community::error;
$error_msg =~ s,\n,
\n,g;
return admin_user_form($error_msg)
}
admin_user(comm_language('ADMIN_USER_ADDED', $user->{comm_username}));
}
sub admin_user_mod {
#--------------------------------------------------------------------
my $db = $DB->table('comm_users');
my $cols = $db->cols;
my $cgi = $IN->get_hash;
my $user = $db->get($cgi->{comm_id});
if (! $user) {
return admin_user(comm_language('ADMIN_USER_MOD_INVALID', $cgi->{comm_id}));
}
$user = _user_from_cgi($IN->get_hash, $user, 1);
require Community::User;
if (Community::User::cuser_email_isinvalid($user->{comm_email})) {
return admin_user_form(comm_language('SIGNUP_EMAIL_INVALID', $user->{comm_email}));
}
if ( $IN->param('new_comm_password') ) {
my $new_pass = $cgi->{new_comm_password};
$new_pass =~ s/^\s*|\s*$//g;
if ( $CFG->{system_store_clear_pass} ) {
$user->{comm_clr_pass} = $new_pass;
}
$user->{comm_password} = comm_encrypt($new_pass);
}
local $GT::SQL::ERRORS->{ILLEGALVAL} = comm_language('ADMIN_DB_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = comm_language('ADMIN_DB_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = comm_language('ADMIN_DB_NOTNULL');
my $res = Community::User::cuser_update($user);
if (! $res) {
my $error_msg = $Community::error;
$error_msg =~ s,\n,
\n,g;
return admin_user_form($error_msg);
}
else {
return admin_user(comm_language('ADMIN_USER_MODIFIED', $user->{comm_username}));
}
}
sub admin_user_del {
#--------------------------------------------------------------------
my $db = $DB->table('comm_users');
my $cgi = $IN->get_hash();
# If they selected only one record to delete we still need an array ref
my $mod = (ref $cgi->{user} eq 'ARRAY') ? $cgi->{user} : [ $cgi->{user} ];
my $rec_modified = 0;
require Community::User;
foreach my $rec_num ( @{$mod} ) {
if ( $cgi->{"$rec_num-comm_username"} ) {
my $user = $db->select( { comm_username => $cgi->{"$rec_num-comm_username"} })->fetchrow_hashref;
next if (! $user);
my $ret = Community::User::cuser_delete($user);
if ( defined $ret and ($ret != 0 ) ) {
$rec_modified++;
}
else {
return admin_user(comm_language('ADMIN_USER_ERROR', $Community::error));
}
}
}
return admin_user(comm_language('ADMIN_USER_DELETED', $rec_modified));
}
sub admin_verify {
#--------------------------------------------------------------------
require Community::User;
my $id = $IN->param('comm_id');
my $user = $DB->table('comm_users')->select( { comm_id => $id } )->fetchrow_hashref;
$user->{comm_email_tmp} ||= $user->{comm_email}; # If the user never had a tmp set.
$user->{comm_email_val} = 1;
$user->{comm_email_code} = '';
$user->{comm_email_redir} = '';
$user->{comm_email} = $user->{comm_email_tmp};
$user->{comm_email_tmp} = '';
require Community::User;
my $res = Community::User::cuser_update($user);
if (! $res) {
my $error_msg = $Community::error;
$error_msg =~ s,\n,
\n,g;
return admin_user_form($error_msg);
}
return admin_user(comm_language('ADMIN_EMAIL_VERIFIED', $user->{comm_username}));
}
sub admin_import {
#--------------------------------------------------------------------
# Import data from either text file or textare box
#
my $method = $IN->param('import_from') || 'text';
my ($dbh, $def_path, $root_path);
if ( $method ne 'text' ) {
$root_path = $IN->param('gt_root_path') || '';
$def_path = $root_path;
if ( $method eq 'gmail' ) {
my $cfg = do "$root_path/GMail/Config/Data.pm";
if ( !$cfg ) {
return ('admin_database_import_step1.html', { error => comm_language('ADMIN_IMPORT_INVALID_CFG_PATH', "$root_path/GMail/ConfigData.pm") });
}
else {
$def_path = "$cfg->{location}->{path}->{data}/admin";
}
}
if ( !-e "$def_path/defs/database.def" ) {
return ('admin_database_import_step1.html', { error => comm_language('ADMIN_IMPORT_INVALID_DB_PATH', "$def_path/defs/database.def") });
}
require GT::SQL;
$dbh = GT::SQL->new({ def_path => "$def_path/defs", debug => $CFG->{debug} });
}
require Community::Import;
Community::Import::process( pro_id => $method, dbh => $dbh, root_path => $root_path, def_path => $def_path);
return;
}
sub admin_export {
#--------------------------------------------------------------------
# Export data from comm_users table to either text file or screen
#
require Community::Export;
Community::Export::process();
return;
}
sub admin_database_resync {
#--------------------------------------------------------------------
# Resync database
#
my $name = $IN->param('db') || 'comm_users';
# We need a creator for this.
my $c = $DB->creator($name);
my $db = $DB->table($name);
$c->load_table or return admin_database_editor({ error => comm_language('ADMIN_DB_RESYNC_ERROR', $GT::SQL::error) });
# Re Load our table object.
$db->reload;
return admin_database_editor({ msg => comm_language('ADMIN_DB_RESYNC') });
}
sub admin_database_editor {
#--------------------------------------------------------------------
# Print profile fields
#
my $opts = ref $_[0] eq 'HASH' ? shift : { @_ };
my $msg = $opts->{msg};
my $error = $opts->{error};
my $db = $DB->table('comm_users');
my $cols = $db->cols;
my @output;
foreach ( $db->ordered_columns ) {
/^prof_/ or next;
$cols->{$_}->{name} = $_;
push @output, $cols->{$_};
}
return ('admin_database_editor.html', { fields => \@output, msg => \$msg, error => \$error });
}
sub admin_database_column_add {
#--------------------------------------------------------------------
# Add a profile field
#
my $column = $IN->param('comm_column') || '';
( $column and $column =~ /^prof_\w+/ ) or return ('admin_database_add_form.html', { error => comm_language('ADMIN_DB_COLUMN_INVALID') });
my $db = $DB->table('comm_users');
my %cols = $db->cols;
my $attribs = _col_spec();
# Error checking
my $errors = _field_check();
if ( exists $cols{$column} ) {
$errors .= comm_language('ADMIN_TAB_COL_TAKEN', $column);
}
$errors and return ('admin_database_add_form.html', { error => \$errors });
$attribs->{pos} = keys (%cols) + 1;
$attribs->{edit} = 1;
$attribs->{default} ||= '';
my $editor = $DB->editor('comm_users');
# Add a column
delete $attribs->{column};
$editor->add_col($column, $attribs) or return ('admin_database_add_form.html', { error => comm_language('ADMIN_DB_ADD_ERROR', $column, $GT::SQL::error) });
# Add the indexes.
if ( $IN->param('comm_index') eq 'regular' ) {
$editor->add_index($column . '_idx' => [$column]) or return ('admin_database_add_form.html', { error => comm_language('ADMIN_DB_INDEX_ERROR', $GT::SQL::error) });
}
if ( $IN->param('comm_index') eq 'unique' ) {
$editor->add_index($column . '_idx' => [$column]) or return ('admin_database_add_form.html', { error => comm_language('ADMIN_DB_UNIQUE_ERROR', $GT::SQL::error) });
}
$db->reload;
return admin_database_editor(msg => comm_language('ADMIN_DB_ADDED', $column));
}
sub admin_database_column_editor {
#--------------------------------------------------------------------
# Form to modify a selected column
#
my $opts = ref $_[0] eq 'HASH' ? shift : { @_ };
my $msg = $opts->{msg};
my $error = $opts->{error};
my %cols = $DB->table('comm_users')->cols;
my $column = $IN->param('c') || return admin_database_editor(error => comm_language('ADMIN_DB_MOD_INVALID'));
my %attribs = %{$cols{$column}};
exists $cols{$column} or return admin_database_editor(error => comm_language('ADMIN_DB_MOD_NOTFOUND', $column));
( $column =~ /^prof_/mi ) or return admin_database_editor(error => comm_language('ADMIN_DB_MOD_NOTPER', $column));
# 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 values size/) {
$attribs{"comm_$col"} = $IN->param("comm_$col") if ( defined $IN->param("comm_$col") );
}
$attribs{column} ||= $column;
$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}}));
my %output;
foreach (keys %attribs ) {
$output{"comm_$_"} = $attribs{$_};
}
my $indexed = _index_list($column);
return ('admin_database_modify_form.html', { msg => \$msg, error => \$error, comm_index => $indexed, %output });
}
sub admin_database_column_modify {
#--------------------------------------------------------------------
# Modify a column
#
my $column = $IN->param('c') || return admin_database_editor(error => comm_language('ADMIN_DB_MOD_INVALID'));
( $column =~ /^prof_/mi ) or return admin_database_editor(error => comm_language('ADMIN_DB_MOD_NOTPER', $column));
# Keep any values that where there before
my $db = $DB->table('comm_users');
my $editor = $DB->editor('comm_users');
my $old_def = $db->cols->{$column};
( $old_def ) or return admin_database_editor(error => comm_language('ADMIN_DB_MOD_NOTFOUND', $column));
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();
$errors and return admin_database_column_editor(error => \$errors);
# Add/Drop indexes.
my $index_type = _index_type($column);
if ( $index_type ne $IN->param('comm_index') ) {
if ($index_type eq 'none') {
if ( $IN->param('comm_index') eq 'regular' ) {
$editor->add_index( $column . "_idx" => [$column] );
}
else {
$editor->add_unique( $column . "_idx" => [$column] );
}
}
elsif ( $IN->param('comm_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 $column);
$editor->drop_index($index_name) or return admin_database_column_editor(error => $GT::SQL::error);
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 $column);
$editor->drop_unique($unique_name) or return admin_database_column_editor(error => $GT::SQL::error);
last INDEX;
}
}
}
}
}
# Make the changes
delete $attribs->{column};
$editor->alter_col($column, $attribs) or return admin_database_column_editor(error => $editor->error);
return admin_database_editor(msg => comm_language('ADMIN_DB_UPDATED', $column));
}
sub admin_database_column_delete {
#--------------------------------------------------------------------
# Remove a profile field
#
my $column = $IN->param('c') || return admin_database_editor(error => comm_language('ADMIN_DB_MOD_INVALID'));
( $column =~ /^prof_/mi ) or return admin_database_editor(error => comm_language('ADMIN_DB_MOD_NOTPER', $column));
# Keep any values that where there before
my $db = $DB->table('comm_users');
my $editor = $DB->editor('comm_users');
my $old_def = $db->cols->{$column};
$old_def or return admin_database_editor(error => comm_language('ADMIN_DB_MOD_NOTFOUND', $column));
# Drop the column from the database.
$editor->drop_col($column) or return admin_database_column_editor(error => $GT::SQL::error);
admin_database_editor(msg => comm_language('ADMIN_DB_DELETED', $column));
}
sub admin_apps {
#--------------------------------------------------------------------
#
my $opts = ref $_[0] eq 'HASH' ? shift : { @_ };
my $msg = $opts->{msg};
my $error = $opts->{error};
my $db = $DB->table('comm_apps');
$db->select_options('ORDER BY app_keyword');
my $cgi = $IN->get_hash;
my $sth = $db->query_sth();
my $hits = $db->hits();
if ( $hits == 0 ) {
$msg ||= comm_language('ADMIN_APPS_NORESULT');
return ('admin_application.html', { msg => \$msg });
}
# Build speed bar
my $speedbar = '';
if ( $hits > ($cgi->{mh} || 25) ) {
my $name = GT::CGI->url(remove_empty => 1);
my $disp = $DB->html($db, $cgi);
$speedbar .= $disp->toolbar($cgi->{nh} || 1, $cgi->{mh} || 25, $hits, $name);
}
my @output;
while ( my $rs = $sth->fetchrow_hashref ) {
push @output, $rs;
}
return ('admin_application.html', {
msg => \$msg,
error => \$error,
results => \@output,
hits => $hits
});
}
sub admin_apps_add {
#--------------------------------------------------------------------
# Add a application
#
my $db = $DB->table('comm_apps');
my $cols = $db->cols;
my $app;
foreach ( keys % $cols ) {
$app->{$_} = $IN->param("$_") if ( $IN->param("$_") );
}
$app->{app_local} = ( $app->{app_type} =~ /^Local\// ) ? 1 : 0;
if ( $app->{app_keyword} !~ /^\w+$/ ) {
return ('admin_apps_add_form.html', { error => comm_language('ADMIN_APPS_INVALID_KEYWORD') });
}
if ( $app->{app_local} ) {
if ( ! -e $app->{app_location} ) {
return ('admin_apps_add_form.html', { error => comm_language('ADMIN_APPS_LOCAL_INVALID') });
}
}
else {
require GT::WWW;
GT::WWW->get($app->{app_location});
}
local $GT::SQL::ERRORS->{ILLEGALVAL} = comm_language('ADMIN_DB_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = comm_language('ADMIN_DB_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = comm_language('ADMIN_DB_NOTNULL');
my $comm_id = $db->add($app);
return ('admin_apps_add_form.html', { error => $GT::SQL::error }) if (! $comm_id );
my $editor = $DB->editor('comm_users');
my $res = $editor->add_col('app_' . $app->{app_keyword}, {
type => 'TINYINT',
unsigned => 1,
default => 0,
form_display => $app->{app_keyword},
form_type => 'checkbox'
});
if (! $res) {
$db->delete($comm_id);
return ('admin_apps_add_form.html', { error => $GT::SQL::error });
}
require Community::Apps;
$res = Community::Apps::run($app, 'install');
if (! $res) {
$db->delete($comm_id);
$editor->drop_col('app_' . $app->{app_keyword});
return ('admin_apps_add_form.html', { error => $Community::error });
}
admin_apps(msg => comm_language('ADMIN_APPS_ADDED', $app->{app_keyword}));
}
sub admin_apps_form {
#--------------------------------------------------------------------
# Print modify form
#
my $opts = ref $_[0] eq 'HASH' ? shift : { @_ };
my $msg = $opts->{msg};
my $error = $opts->{error};
my $app_id = $IN->param('app_id') or return admin_apps(error => comm_language('ADMIN_APPS_INVALID'));
my $app = $DB->table('comm_apps')->get($app_id);
( $app ) or return admin_apps(error => comm_language('ADMIN_APPS_NOTFOUND', $app_id));
my $users = $DB->table('comm_users');
my $enable = $users->count({ "app_$app->{app_keyword}" => 2 });
my $disable = $users->count({ "app_$app->{app_keyword}" => 1 });
my $null = $users->count({ "app_$app->{app_keyword}" => 0 });
return ('admin_apps_modify_form.html', {
msg => \$msg,
error => \$error,
enabled => $enable,
disabled => $disable,
not_registered => $null,
%$app
});
}
sub admin_apps_modify {
#--------------------------------------------------------------------
# Modify a application
#
my $app_id = $IN->param('app_id') or return admin_apps(error => comm_language('ADMIN_APPS_INVALID'));
my $cgi = $IN->get_hash;
my $db = $DB->table('comm_apps');
my $cols = $db->cols;
my $app = $db->get($app_id);
my $hash;
foreach ( keys % $cols ) {
if ( $_ eq 'app_autocreate' ) {
$hash->{$_} = ( $cgi->{$_} ) ? 1 : 0;
}
elsif ( $_ eq 'app_location') {
$hash->{$_} = $cgi->{$_} if ( $cgi->{$_} );
}
else {
$hash->{$_} = $app->{$_};
}
}
$hash->{app_local} = ( $hash->{app_type} =~ /^Local\// ) ? 1 : 0;
if ( $hash->{app_local} ) {
return admin_apps_form(error => comm_language('ADMIN_APPS_LOCAL_INVALID')) if ( !-e $hash->{app_location} );
}
else {
require GT::WWW;
GT::WWW->get($hash->{app_location});
}
# Setup the language for GT::SQL.
local $GT::SQL::ERRORS->{ILLEGALVAL} = comm_language('ADMIN_DB_ILLEGALVAL');
local $GT::SQL::ERRORS->{UNIQUE} = comm_language('ADMIN_DB_UNIQUE');
local $GT::SQL::ERRORS->{NOTNULL} = comm_language('ADMIN_DB_NOTNULL');
if ( $db->modify ($hash) ) {
return admin_apps(msg => comm_language('ADMIN_APPS_UPDATED', $hash->{app_keyword}));
}
else {
local $^W;
my $error = $GT::SQL::error;
$error =~ s/\n/
\n/g;
return admin_apps_form(error => \$error);
}
}
sub admin_apps_delete {
#--------------------------------------------------------------------
# Delete applications
#
my $db = $DB->table('comm_apps');
my $cgi = $IN->get_hash();
# If they selected only one record to delete we still need an array ref
my $mod = ( ref $cgi->{app} eq 'ARRAY' ) ? $cgi->{app} : [$cgi->{app}];
# For through the record numbers. These are the values of the
# check boxes
my $rec_modified = 0;
foreach my $rec_num ( @{$mod} ) {
if ( $cgi->{"$rec_num-app_id"} ) {
my $hsh = $db->get($cgi->{"$rec_num-app_id"});
my $ret = $db->delete({ app_id => $cgi->{"$rec_num-app_id"} });
if ( defined $ret and ($ret != 0 ) and $hsh) { # Uninstall the application
my $editor = $DB->editor('comm_users');
$editor->drop_col('app_' . $hsh->{app_keyword});
require Community::Apps;
my $res = Community::Apps::run($hsh, 'uninstall');
$rec_modified++;
}
}
}
return admin_apps(msg => comm_language('ADMIN_APPS_DELETED', $rec_modified));
}
sub admin_apps_users {
#--------------------------------------------------------------------
# Present a form to the adminto choose which users will be able
# to access this application
#
my $cgi = $IN->get_hash;
my $app_id = $cgi->{app_id} or return admin_apps(error => comm_language('ADMIN_APPS_INVALID'));
my $db = $DB->table('comm_apps');
my $app = $db->get($app_id);
my $tags = {%$app};
my $template = 'admin_apps_users.html';
my $user_tbl = $DB->table('comm_users');
# Show admin a list of all the searched results. This will
# enable the admin to review all users that will be affected
# by the subsequent actions
my $action = $cgi->{action};
if ( $action eq 'search' ) {
$cgi->{sb} ||= 'comm_username';
my $usth = $user_tbl->query_sth( $cgi );
my $hits = $user_tbl->hits();
my $url = GT::CGI->url(remove_empty => 1);
my $mh = $cgi->{mh} || 25;
my $nh = $cgi->{nh} ? $cgi->{nh} : 1;
my $disp = $DB->html($db, $cgi);
my $speed_bar;
if ( $hits > $mh ) {
$speed_bar .= $disp->toolbar($nh, $mh, $hits, $url);
}
$tags->{comm_users_hits} = int( $hits || 0 );
my $users = $tags->{comm_users_loop} = $usth->fetchall_hashref;
if ( $users ) {
foreach my $user ( @$users ) {
$user->{comm_user_app_access} = $user->{'app_' . $app->{app_keyword}};
}
}
$tags->{speed_bar} = \$speed_bar if $speed_bar;
$template = 'admin_apps_users_search.html';
}
# If additional constraints must be provided to the user's
# activation, the application can insert portions of an interface
# here
elsif ( $action eq 'parameters' ) {
my $usth = $user_tbl->query_sth( $IN );
$tags->{comm_users_hits} = $user_tbl->hits();
require Community::Apps;
$tags->{prototype_template_form} = \Community::Apps::run( $app, 'prototype_template_form' );
$tags->{update_mode} = $IN->param( 'disable_users' ) ? 'disable' : 'enable';
$template = 'admin_apps_users_parameters.html';
}
# In staggered format, modify all the users with the requested
# parameters.
elsif ( $action eq 'modify' ) {
$cgi->{sb} = 'comm_username';
$cgi->{so} = 'ASC';
$cgi->{mh} ||= 100;
my $user_sth = $user_tbl->query_sth( $cgi );
$tags->{comm_users_hits} = $user_tbl->hits;
my @proto_fields = grep /^proto_/, keys %$cgi;
my %proto_actions = map {
my $v = $cgi->{$_};
s/^proto_//;
( $_ => $v );
} @proto_fields;
require Community::User;
require Community::Web::SSI;
my ( @successful_updates, @failed_updates );
while ( my $user = $user_sth->fetchrow_hashref ) {
$user = {%$user};
$tags->{'comm_username-gt'} = $user->{comm_username};
# Update with prototyping information if required
# Also, preserve prototyping information
my $hidden_proto_html = '';
foreach my $field ( keys %proto_actions ) {
my $proto_html = Community::Web::SSI::ssi_form_control({
form_type => 'hidden',
name => "proto_".$field,
value => $proto_actions{$field},
def => {},
}) or next;
$hidden_proto_html .= $$proto_html;
next unless $user->{$field} =~ /^\s*$/;
( $user->{$field} = $proto_actions{$field} ) =~ s/%(\w+)%/$user->{$1}/eg;
}
$tags->{hidden_proto_html} = \$hidden_proto_html;
# Set enable/disable information
$user->{ 'app_' . $app->{app_keyword} } = $cgi->{update_mode} eq 'enable' ? 2 : 1;
if ( Community::User::cuser_update( $user ) ) {
$user->{comm_user_app_access} = $user->{'app_' . $app->{app_keyword}} || 0;
push @successful_updates, $user;
}
else {
$user->{error} = \"$Community::error";
push @failed_updates, $user;
}
}
if ( $tags->{comm_users_hits} > ( @successful_updates + @failed_updates ) ) {
$tags->{users_remaining} = $tags->{comm_users_hits} - ( @successful_updates + @failed_updates );
}
else {
$tags->{msg} = comm_language( 'ADMIN_APPS_USER_COMPLETED');
}
@successful_updates and $tags->{successful_loop} = \@successful_updates;
@failed_updates and $tags->{failed_loop} = \@failed_updates;
$template = 'admin_apps_users_modify.html';
}
return ( $template, $tags );
}
sub admin_sql {
#--------------------------------------------------------------------
# Send SQL command to SQL server
#
my $query = $IN->param('sql_query');
return ('admin_database_sql.html', { error => comm_language('ADMIN_INVALID_SQL') }) if ( !$query );
my $creator = $DB->creator('sql');
my $sth = $creator->{table}->prepare($query) or return ('admin_database_sql.html', { error => $SQL::GT::error });
my $res = $sth->execute();
if (! $res) {
return ('admin_database_sql.html', { error => $GT::SQL::error });
}
if ( $IN->param('file_name') ) { # Print to a file
my $file_name = ( $IN->param('file_name') =~ m,^\/, ) ? $IN->param('file_name') : "$CFG->{path_private}/".$IN->param('file_name');
open (FILE, "> $file_name") or return ('admin_database_sql.html', { error => comm_language('ADMIN_UNABLE_OPEN_FILE', $file_name, $!) });
while ( my $rs = $sth->fetchrow_arrayref ) {
print FILE join("\t", @$rs), "\n";
}
close FILE;
return ('admin_database_sql.html', { msg => \comm_language('ADMIN_SQL_SAVED', $file_name) });
}
else { # Print to the screen
my $output;
my $count = 0;
while ( my $rs = $sth->fetchrow_arrayref ) {
$output .= join("\t", @$rs)."\n";
$count++;
}
return ('admin_database_sql.html', { sql_results => $output, msg => \comm_language('ADMIN_SQL_RESULTS', $count) });
}
}
sub admin_online {
#--------------------------------------------------------------------
# Print who is online
#
my $min = $IN->param('min') || 60;
my $mh = $IN->param('mh') || $CFG->{admin_page_per_screen} || 25;
my $nh = $IN->param('nh') || 1;
my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh; # started record
require GT::SQL::Condition;
my $db = $DB->table('comm_users', 'comm_sessions');
my $cd = GT::SQL::Condition->new(
'sess_expire', '>=', time,
'sess_accessed', '>=', time - ($min * 60)
);
my $hits = $db->count($cd);
return ('admin_online.html', { msg => \comm_language('ADMIN_ONLINE_RESULTS', 0) }) if ( !$hits );
$db->select_options("ORDER BY sess_accessed DESC", "LIMIT $bg, $mh");
my $sth = $db->select($cd);
my @online_results;
require GT::Date;
while ( my $rs = $sth->fetchrow_hashref ) {
$rs->{sess_accessed} = GT::Date::date_get($rs->{sess_accessed}, '%mm%-%dd%-%yyyy% %hh%:%MM%:%ss%');
push @online_results, $rs;
}
# Build speed bar
my $speed_bar;
if ( $hits > $mh ) {
my $url = GT::CGI->url(remove_empty => 1);
my $disp = $DB->html($db, $IN->get_hash);
$speed_bar .= $disp->toolbar($nh, $mh, $hits, $url);
}
return ('admin_online.html', {
speed_bar => \$speed_bar,
online_results => \@online_results,
msg => \comm_language('ADMIN_ONLINE_RESULTS', $hits)
});
}
sub admin_setup {
#--------------------------------------------------------------------
#
my $pg = $IN->param('pg') || 'admin_setup_misc.html';
if ( $pg eq 'admin_setup_email.html' and $IN->param('email_sendmail') and $IN->param('email_smtp') ) {
return ($pg, { msg => \comm_language('ADMIN_SETUP_INVALID_SMTP') });
}
elsif ( $pg eq 'admin_setup_path.html' and ( !$IN->param('path_cgi_url') or !$IN->param('path_images_url') or !$IN->param('path_private') ) ) {
return ($pg, { msg => \comm_language('ADMIN_SETUP_INVALID_URL') });
}
_update_cfg();
$CFG->save();
return ($pg, { msg => \comm_language('ADMIN_SETUP_UPDATED') });
}
sub admin_setup_sql {
# -------------------------------------------------------------------
# Setup the SQL server
#
my $action = $IN->param('action');
if ($action !~ /^create|overwrite|load$/) {
return ('admin_setup_sql.html', { error => comm_language('ADMIN_SETUP_SQL_INVALID', $action) });
}
my ($port, $output);
my $host = $IN->param('host');
($host =~ s/\:(\d+)$//) and ($port = $1);
# Setup the SQL Connection
require Community::SQL;
my $ret = Community::SQL::setup_database(
driver => scalar $IN->param('driver'),
host => $host,
port => $port,
database => scalar $IN->param('database'),
login => scalar $IN->param('login'),
password => scalar $IN->param('password'),
prefix => $IN->param('prefix'),
);
if (! $ret) {
return ('admin_setup_sql.html', { error => $GT::SQL::error });
}
# Setup the tables
if ($action eq 'create') {
$output = Community::SQL::setup_tables('check');
if (! $output) {
return ('admin_setup_sql.html', { error => $GT::SQL::error });
}
}
elsif ($action eq 'overwrite') {
$output = Community::SQL::setup_tables('force');
}
elsif ($action eq 'load') {
$output = Community::SQL::load_sql();
}
return ('admin_setup_sql.html', { msg => $output });
}
sub admin_setup_pwd {
#-------------------------------------------------------------------
# Change the password and set admin ips.
#
my $admin = $IN->param('con_user') || $CFG->{admin_username};
my $old_pwd = $IN->param('old_pwd') || '';
my $new_pwd = $IN->param('new_pwd') || '';
my $con_pwd = $IN->param('con_pwd') || '';
# Check for new ips, and update the config as required.
my $curr_ip = $ENV{REMOTE_ADDR};
my $old_list = join("\n", @{$CFG->{admin_ips}});
my @new_ips = grep (/^\d+\.\d+\.\d+\.\d+$/, split (/\s*\r?\n\s*/, $IN->param('ips')));
my $new_list = join("\n", @new_ips);
$new_list ||= $old_list;
my %tags = (
curr_ip => $curr_ip,
ips => $new_list,
con_user => $admin,
);
if ($new_list ne $old_list) {
unless (grep { $curr_ip eq $_ } @new_ips) {
$tags{error} = comm_language('ADMIN_SETUP_INVALID_IP', $curr_ip);
return ('admin_setup_pwd.html', \%tags);
}
$CFG->{admin_ips} = \@new_ips;
$CFG->save;
$tags{msg} = comm_language('ADMIN_SETUP_IP_UPDATED');
}
if ( !$old_pwd and !$new_pwd and !$con_pwd) {
return ('admin_setup_pwd.html', \%tags);
}
if ( !$old_pwd or !$new_pwd or !$con_pwd or !$admin) {
$tags{error} = comm_language('ADMIN_SETUP_INVALID_PWD');
return ('admin_setup_pwd.html', \%tags);
}
unless (comm_compare_pass($old_pwd, $CFG->{admin_password})) {
$tags{error} = comm_language('ADMIN_SETUP_INVALID_OLDPWD');
return ('admin_setup_pwd.html', \%tags);
}
if ( $new_pwd ne $con_pwd ) {
$tags{error} = comm_language('ADMIN_SETUP_INVALID_NEWPWD');
return ('admin_setup_pwd.html', \%tags);
}
# Encrypt the password.
my $clear_pass = $new_pwd;
$CFG->{admin_password} = comm_encrypt($clear_pass);
$CFG->{admin_username} = $admin;
$CFG->save();
my $cookies = [
$IN->cookie( -name => 'Community_Admin_Pass', -value => $CFG->{admin_password} )
];
require Community::Web::Admin;
$tags{msg} = comm_language('ADMIN_SETUP_PWD_UPDATED');
return ('admin_setup.html', \%tags, {}, $cookies );
}
sub admin_env {
#--------------------------------------------------------------------
# Return HTML formatted environment for error messages.
#
my $info = '';
# Stack trace.
my $i = 0;
$info .= "Stack Trace\n======================================\n";
$info .= GT::Base::stack_trace('Community', 1, 1);
$info .= "\n\n";
# Print GT::SQL error if it exists.
$info .= "System Information\n======================================\n";
$info .= "Perl Version: $]\n";
$info .= "DBI.pm Version: $DBI::VERSION\n" if ($DBI::VERSION);
$info .= "Persistant Env: mod_perl ($MOD_PERL) SpeedyCGI ($SPEEDY)\n";
$info .= "Mod Perl Version: $mod_perl::VERSION\n" if (defined $ENV{GATEWAY_INTERFACE} and ($ENV{GATEWAY_INTERFACE} =~ /perl/i));
$info .= "GT::SQL::error = $GT::SQL::error\n" if ($GT::SQL::error);
$info .= "DBI::errstr = $DBI::errstr\n" if (defined $DBI::errstr);
$info .= "\@INC = \n\t" . join ("\n\t", @INC) . "\n";
$info .= "\$\@: $@\n" if ($@);
$info .= "\n";
# CGI Parameters and Cookies.
if (ref $IN eq 'GT::CGI') {
if ($IN->param) {
$info .= "CGI INPUT\n======================================\n";
foreach (sort $IN->param) { $info .= "$_ => " . $IN->param($_) . "\n"; }
$info .= "\n\n";
}
if ($IN->cookie) {
$info .= "CGI Cookies\n======================================\n";
foreach (sort $IN->cookie) { $info .= "$_ => " . $IN->cookie($_) . "\n"; }
$info .= "\n\n";
}
}
# Environement info.
$info .= "ENVIRONMENT\n======================================\n";
foreach (sort keys %ENV) { $info .= "$_ => $ENV{$_}\n"; }
$info .= "";
return ('admin_environment.html', { info => \$info });
}
sub admin_logout {
#---------------------------------------------------------------------
my $cookies = [
$IN->cookie( -name => 'Community_Admin_Pass', -value => '', -expire => '-1y' )
];
require Community::Web::User;
Community::Web::User::user_page( 'user_login.html', { session_admin => 0 }, {}, $cookies );
return;
}
sub admin_initial_setup {
#---------------------------------------------------------------------
#
my ($host, $port, $overwrite);
unless ( $IN->param('initial_step') ) {
return ('admin_initial_setup_first.html');
}
if ( $IN->param('initial_step') == 2 ) {
return ('admin_initial_setup_second.html');
}
# Test the ability to create a def file.
unless (open (TEST, "> $CFG->{path_private}/defs/database.def") ) {
return ('admin_initial_setup_second.html', {
error => \qq~
Unable to create our def file in $CFG->{path_private}/defs/.
\n
Please make sure this directory exists, and is writeable by the server.
\n
If this is the wrong directory, you will need to manually set the directory
\n
in community.conf. Error was: $!
~
});
}
close TEST;
# Set the connection info.
$overwrite = $IN->param('overwrite') ? 'force' : 'check';
$host = $IN->param('host');
($host =~ s/\:(\d+)$//) and ($port = $1);
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 Community::SQL; };
if ($@) { return ('admin_initial_setup_second.html', { error => "Unable to load Dbsql::SQL module: $@\n" }); }
my $output = Community::SQL::setup_tables($overwrite);
# And lets set sensible defaults for the rest of the config vars.
$CFG->{system_setup} = 1;
_update_cfg();
# And save the config.
$CFG->save();
return ('admin_initial_setup_third.html', { message => \"The data tables have been setup: $output
" } );
}
sub admin_view_file {
#---------------------------------------------------------------------------
my $msg = shift;
my $id = $IN->param('id');
my $cn = $IN->param('cn');
my $src = $IN->param('src') || 'db';
my $fname = $IN->param('fname');
die comm_language('ADMIN_FILE_INVALID') if ( not ( $id and $cn ) ) ;
my $tbl = $DB->table('comm_users');
my ( $fh, $mimetype, $size );
if ( $src eq 'db' ) {
print $src;
eval { $fh = $tbl->file_info( $cn, $id ); };
if ( $fh ) {
$fname = $fh->File_Name();
$mimetype = $fh->File_MimeType();
$size = $fh->File_Size();
}
}
else {
require GT::SQL::File;
require GT::MIMETypes;
eval { $fh = GT::SQL::File->open($fname) };
$mimetype = GT::MIMETypes->guess_type($fname);
$fname = GT::SQL::File::get_filename($fname);
}
if ( !$fh ) {
die comm_language('ADMIN_FILE_ERROR');
}
else {
print $IN->header(
'-type' => $mimetype,
'-Content-Length' => $size,
'-Content-Disposition' => \("inline; filename=".$fname)
);
$fh->File_Binary() and binmode STDOUT;
while ( read($fh, my $buffer, 4096) ) {
print $buffer;
}
}
return;
}
sub admin_download_file {
#---------------------------------------------------------------------------
my $msg = shift;
my $id = $IN->param('id');
my $cn = $IN->param('cn');
my $src = $IN->param('src') || 'db';
my $fname = $IN->param('fname');
die comm_language('ADMIN_FILE_INVALID') if ( not ( $id and $cn ) ) ;
my $tbl = $DB->table('comm_users');
my ($fh, $mimetype, $size);
if ( $src eq 'db' ) {
eval { $fh = $tbl->file_info($cn, $id ); };
if ( $fh ) {
$fname = $fh->File_Name();
$mimetype = $fh->File_MimeType();
$size = $fh->File_Size();
}
}
else {
require GT::SQL::File;
require GT::MIMETypes;
eval { $fh = GT::SQL::File->open($fname) };
$mimetype = GT::MIMETypes->guess_type($fname);
$fname = GT::SQL::File::get_filename($fname);
}
if (!$fh) {
die comm_language('ADMIN_FILE_ERROR');
}
else {
print $IN->header(
'-type' => 'application/download',
'-Content-Length' => $size,
'-Content-Transfer-Encoding' => 'binary',
'-Content-Disposition' => \("attachment; filename=".$fname)
);
$fh->File_Binary() and binmode STDOUT;
while ( read ($fh, my $buffer, 4096) ) {
print $buffer;
}
}
return;
}
sub admin_plugin {
# ------------------------------------------------------------------
# Run a plugin function.
#
my $plugin = $IN->param('plugin');
if ($IN->param('download') and ($plugin =~ /^[\w\-]+$/)) {
my $path = "$CFG->{path_private}/lib/Plugins/Community/Uninstalled/$plugin.tar";
-e $path or die "No plugin ($path) found.";
open FH, $path or die "Could not open $path for reading";
print $IN->header(
'-type' => 'application/octet-stream',
'-Content-Disposition' => 'attachment; filename="'.$plugin.'.tar"'
);
print while ;
close FH;
return;
}
my $func = $IN->param('func');
{
eval { require "Plugins/Community/$plugin.pm"; };
if ($@) {
die "Unable to load plugin: $plugin ($@)";
}
}
no strict 'refs';
my $code = ${"Plugins::Community::" . $plugin . "::"}{$func};
use strict 'refs';
if (!defined $code) {
die "Invalid plugin function: $func";
}
return $code->();
}
sub admin_help {
# ------------------------------------------------------------------
# Print the help pages.
#
my $topic = $IN->param('topic') || 'help_toc.html';
my $help_path = "$CFG->{path_private}/templates/$CFG->{system_template_set}/help";
$topic =~ s,^/|/$,,;
# Add config vars.
my $vars = {};
foreach my $key (keys %$CFG) {
$vars->{$key} = $CFG->{$key} unless (exists $vars->{$key});
}
# Make CGI input available.
foreach my $key ($IN->param) {
$vars->{$key} = $IN->param($key) unless (exists $vars->{$key});
}
# Check the topic file.
unless ( $topic =~ /^[\w\/]+\.[\w]+$/ ) {
die "Invalid topic: $topic";
}
if ( $topic =~ /\.(gif|jpg)$/ and -e "$help_path/$topic" ) {
open IMG, "< $help_path/$topic" or die "Unable to open image help: $help_path/$topic ($!)";
binmode IMG;
local *BINSTDOUT;
open BINSTDOUT, ">&STDOUT";
print BINSTDOUT $IN->header("image/$1");
binmode BINSTDOUT;
print BINSTDOUT while ![]()
;
close IMG;
}
else {
return ($topic, $vars, { print => 1, root => $help_path });
}
}
sub _search_bar {
#---------------------------------------------------------------------
# create quick search bar
#
my $current = $IN->param('alpha') || '';
my @alpha = qw/All A B C D E F G H I J K L M N O P Q R S T U V W X Y Z/;
my ($search_bar, $items);
$items->{All} = 'all';
my $user_db = $DB->table('comm_users');
my $count = $user_db->count;
if ($count > 500) {
for ('A' .. 'Z') { $items->{$_} = $_; }
}
else {
$user_db->select_options('ORDER BY comm_username');
my $sth = $user_db->select();
while ( my $rs = $sth->fetchrow_hashref ) {
my $key = uc(substr($rs->{comm_username}, 0, 1));
exists $items->{$key} or $items->{$key} = $key;
}
}
my $url = "$CFG->{path_cgi_url}?do=admin_user";
foreach ( @alpha ) {
if ( $_ eq 'All' ) {
$search_bar .= ( (!$current or $current eq 'all') and !$IN->param('bsearch') ) ? "$_ " : "$_ ";
}
elsif ( $items->{$_} ) {
$search_bar .= ( uc $current eq $_ ) ? "$_ " : "$_ ";
}
else {
$search_bar .= "$_ ";
}
}
return $search_bar;
}
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);
}
}
}
}
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->{comm_column} || $cgi->{c};
my $form_type = uc($cgi->{comm_form_type});
my $type = uc($cgi->{comm_type});
return comm_language('ADMIN_TAB_COL_NAME') if ( $col_name !~ /^(\w+)$/ );
# Max lengths
if (( $type eq 'CHAR' ) and ( $cgi->{comm_size} > 255 ) ) {
return comm_language('ADMIN_TAB_COL_SIZE');
}
if ( ( $form_type =~ /SELECT|MULTIPLE|CHECKBOX|RADIO/mi ) and ( !$cgi->{comm_form_values} or !$cgi->{comm_form_names}) ) {
return comm_language('ADMIN_TAB_COL_VALUES');
}
if ( $form_type eq 'DATE' and ($type ne 'DATE')) {
return comm_language('ADMIN_TAB_COL_DATE');
}
if ( ( $cgi->{comm_index} eq 'index' or $cgi->{comm_index} eq 'unique' ) and ( !$cgi->{comm_not_null} ) ) {
return comm_language('ADMIN_TAB_COL_NOTNULL', $col_name);
}
if ( ( $form_type eq 'FILE' ) and ( $type ne 'CHAR' ) and ( $type ne 'VARCHAR' ) ) {
return comm_language('ADMIN_TAB_COL_FILE_TYPE');
}
my $location = $cgi->{comm_file_save_in};
if ( ( $form_type eq 'FILE' ) and ( !$location ) ) {
return comm_language('ADMIN_TAB_COL_FILE_IN');
}
if ( ( $form_type eq 'FILE' ) and ( !-w $location ) ) {
return comm_language('ADMIN_TAB_COL_FILE_ERR', $location);
}
}
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->{comm_type};
if ( $cgi->{comm_type} eq 'ENUM' ) {
$col_spec->{'values'} = [split /(?:\n|\r)+/, $cgi->{comm_values}];
}
else {
$col_spec->{'size'} = $cgi->{comm_size};
}
$col_spec->{'default'} = $cgi->{comm_default};
$col_spec->{'not_null'} = ( $cgi->{comm_not_null} ) ? '1' : '0';
if ( defined $cgi->{comm_form_display} ) { $col_spec->{'form_display'} = $cgi->{comm_form_display}; }
if ( defined $cgi->{comm_form_type} ) { $col_spec->{'form_type'} = $cgi->{comm_form_type}; }
if ( defined $cgi->{comm_form_size} ) { $col_spec->{'form_size'} = $cgi->{comm_form_size}; }
if ( defined $cgi->{comm_form_names} ) { $col_spec->{'form_names'} = [split /(?:\n|\r)+/, $cgi->{comm_form_names}]; }
if ( defined $cgi->{comm_form_values} ) { $col_spec->{'form_values'} = [split /(?:\n|\r)+/, $cgi->{comm_form_values}]; }
if ( defined $cgi->{comm_regex} ) { $col_spec->{'regex'} = $cgi->{comm_regex}; }
if ( $cgi->{comm_file_save_in} ) {
$col_spec->{'file_save_in'} = $cgi->{comm_file_save_in};
$col_spec->{'file_save_scheme'} = $cgi->{comm_file_save_scheme};
$col_spec->{'file_max_size'} = $cgi->{comm_file_max_size};
}
elsif ( $cgi->{comm_file_save_url} ) {
$col_spec->{file_save_url} = $cgi->{comm_file_save_url};
}
return $col_spec;
}
sub _index_type {
#-----------------------------------------------------------------
my $column = shift;
my $db = $DB->table('comm_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;
}
sub _index_list {
#-----------------------------------------------------------------
my $column = shift;
my $db = $DB->table('comm_users');
my $indexed = $IN->param('comm_index') || 'none';
if ( $column and ! $IN->param('comm_index') ) {
$db->_is_indexed($column) and ($indexed = 'regular');
$db->_is_unique($column) and ($indexed = 'unique');
$db->_is_pk($column) and ($indexed = 'primary');
}
return $indexed;
}
sub _user_from_cgi {
#-----------------------------------------------------------------
my ($cgi, $user, $checkboxes) = @_;
my $cols = $DB->table('comm_users')->cols;
foreach (keys %$cgi) {
my $val;
if (ref $cgi->{$_} eq 'ARRAY') {
require GT::SQL::Display::HTML;
$val = join ($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort (@{$cgi->{$_}}));
}
else {
$val = $cgi->{$_} || '';
}
if (exists $cols->{$_}) {
$user->{$_} = $val;
}
elsif (/^app_[A-Za-z0-9]+_\w+$/) {
$user->{$_} = $val;
}
elsif (/(.*)-(?:day|mon|year)$/) {
my $col = $1;
$user->{$col} = $cgi->{"$col-year"} . "-" . $cgi->{"$col-mon"} . "-" . $cgi->{"$col-day"};
$IN->param($col, $user->{$col});
}
}
# We go through some extra hoops to handle the case where a user has submitted
# an unchecked checkbox.
if ($checkboxes) {
foreach my $col (keys %$cols) {
next unless (lc $cols->{$col}->{form_type} eq 'checkbox');
$user->{$col} = 0 if (! defined $IN->param($col));
}
}
return $user;
}
1;
__END__
=head1 NAME
Community::Web::Admin - admin front end for Gossamer Community
=head1 DESCRIPTION
This module implements the web front end for Gossamer Community admin
functions and is not meant to be used directly, but rather called
from community.cgi.
=head1 MAINTAINER
Alex Krohn
=head1 COPYRIGHT
Copyright (c) 2002 Gossamer Threads Inc. All Rights Reserved.
http://www.gossamer-threads.com/
=head1 VERSION
Revision: $Id: Admin.pm,v 1.65 2003/05/31 23:26:30 aki Exp $
=cut