PerlModuleUsers
Jump to navigation
Jump to search
SlashDocumentationIndex parent
Functions in users
users.pl:
adminDispatch, changePasswd, checkList, displayForm,
editComm, editHome, editKey, editMiscOpts,
editTags, editUser, forceAccountVerify, getCommentListing,
getError, _get_lastjournal, getMessage, getOtherUserParams,
getTitle, getUserAdmin, listAbuses, listBanned,
listReadOnly, mailPasswd, main, newUser,
newUserForm, noUser, previewSlashbox, saveComm,
saveHome, saveMiscOpts, savePasswd, saveTags,
saveUser, saveUserAdmin, setToDefaults, showBookmarks,
showComments, showFireHose, showInfo, showSubmissions,
showTags, tildeEd, topAbusers, validateUser,
users2.pl:
adminDispatch, checkList, displayForm, editKey,
editMiscOpts, editUser, forceAccountVerify, getCommentListing,
getError, _get_lastjournal, getMessage, getOtherUserParams,
getTitle, getUserAdmin, listAbuses, listBanned,
listReadOnly, mailPasswd, main, newUser,
newUserForm, noUser, previewSlashbox, saveMiscOpts,
saveUser, saveUserAdmin, setToDefaults, showFireHose,
showInfo, tildeEd, topAbusers, validateUser,
Comparison, users vs users2
users users2 ----------------------------- adminDispatch adminDispatch changePasswd checkList checkList displayForm displayForm editComm editHome editKey editKey editMiscOpts editMiscOpts editTags editUser editUser forceAccountVerify forceAccountVerify getCommentListing getCommentListing getError getError _get_lastjournal _get_lastjournal getMessage getMessage getOtherUserParams getOtherUserParams getTitle getTitle getUserAdmin getUserAdmin listAbuses listAbuses listBanned listBanned listReadOnly listReadOnly mailPasswd mailPasswd main main newUser newUser newUserForm newUserForm noUser noUser previewSlashbox previewSlashbox saveComm saveHome saveMiscOpts saveMiscOpts savePasswd saveTags saveUser saveUser saveUserAdmin saveUserAdmin setToDefaults setToDefaults showBookmarks showComments showFireHose showFireHose showInfo showInfo showSubmissions showTags tildeEd tildeEd topAbusers topAbusers validateUser validateUser
Man page for users
Don't waste your time...
# man Slash::Users
No manual entry for Slash::Users
[root@slashcode htdocs]# man Slash::Users2
Users2(3) User Contributed Perl Documentation Users2(3)
NAME
Slash::Users2
SYNOPSIS
use Slash::Users2;
DESCRIPTION
Provides homepages for users.
AUTHOR
Christopher Brown, cbrown@corp.sourcefore.com
SEE ALSO
perl(1).
perl v5.10.1 2014-02-20 Users2(3)
Source of users.pl
#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2005 by Open Source Technology Group. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$
use strict;
use Digest::MD5 'md5_hex';
use Slash;
use Slash::Display;
use Slash::Utility;
use Slash::Constants qw(:messages);
#################################################################
sub main {
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $gSkin = getCurrentSkin();
my $formname = $0;
$formname =~ s/.*\/(\w+)\.pl/$1/;
my $error_flag = 0;
my $formkey = $form->{formkey};
my $suadmin_flag = $user->{seclev} >= 10000 ? 1 : 0 ;
my $postflag = $user->{state}{post};
my $op = lc($form->{op});
# savepasswd is a special case, because once it's called, you
# have to reload the form, and you don't want to do any checks if
# you've just saved.
my $savepass_flag = $op eq 'savepasswd' ? 1 : 0 ;
my $ops = {
admin => {
function => \&adminDispatch,
seclev => 10000, # if this should be lower,
# then something else is
# broken, because it allows
# anyone with this seclev
# to change their own seclev
formname => $formname,
# just in case we need it for something else, we have it ...
checks => [ qw (generate_formkey) ],
},
# userlogin => {
# function => \&showInfo,
# seclev => 1,
# formname => $formname,
# checks => [],
# tab_selected_1 => 'me',
# },
no_user => {
function => \&noUser,
seclev => 0,
formname => $formname,
checks => [],
},
userinfo => {
function => \&showInfo,
#I made this change, not all sites are going to care. -Brian
seclev => $constants->{users_show_info_seclev},
formname => $formname,
checks => [],
tab_selected_1 => 'me',
tab_selected_2 => 'info',
},
userfirehose => {
function => \&showFireHose,
seclev => 0,
formname => $formname,
checks => [],
tab_selected_1 => 'me',
tab_selected_2 => 'firehose'
},
usersubmissions => {
function => \&showSubmissions,
#I made this change, not all sites are going to care. -Brian
seclev => $constants->{users_show_info_seclev},
checks => [],
tab_selected_1 => 'me',
},
usercomments => {
function => \&showComments,
#I made this change, not all sites are going to care. -Brian
seclev => $constants->{users_show_info_seclev},
checks => [],
tab_selected_1 => 'me',
},
display => {
function => \&showInfo,
#I made this change, not all sites are going to care. -Brian
seclev => $constants->{users_show_info_seclev},
formname => $formname,
checks => [],
tab_selected_1 => 'me',
tab_selected_2 => 'info',
},
# savepasswd => {
# function => \&savePasswd,
# seclev => 1,
# post => 1,
# formname => $formname,
# checks => [ qw (max_post_check valid_check
# formkey_check regen_formkey) ],
# tab_selected_1 => 'preferences',
# tab_selected_2 => 'password',
# },
saveuseradmin => {
function => \&saveUserAdmin,
seclev => 10000,
post => 1,
formname => $formname,
checks => [],
},
savehome => {
function => \&saveHome,
seclev => 1,
post => 1,
formname => $formname,
checks => [ qw (valid_check
formkey_check regen_formkey) ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'home',
},
savecomm => {
function => \&saveComm,
seclev => 1,
post => 1,
formname => $formname,
checks => [ qw (valid_check
formkey_check regen_formkey) ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'comments',
},
saveuser => {
function => \&saveUser,
seclev => 1,
post => 1,
formname => $formname,
checks => [ qw (valid_check
formkey_check regen_formkey) ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'user',
},
# changepasswd => {
# function => \&changePasswd,
# seclev => 1,
# formname => $formname,
# checks => $savepass_flag ? [] :
# [ qw (generate_formkey) ],
# tab_selected_1 => 'preferences',
# tab_selected_2 => 'password',
# },
editmiscopts => {
function => \&editMiscOpts,
seclev => 1,
formname => $formname,
checks => [ ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'misc',
},
savemiscopts => {
function => \&saveMiscOpts,
seclev => 1,
formname => $formname,
checks => [ ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'misc',
},
edituser => {
function => \&editUser,
seclev => 1,
formname => $formname,
checks => [ qw (generate_formkey) ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'user',
},
authoredit => {
function => \&editUser,
seclev => 10000,
formname => $formname,
checks => [],
},
edithome => {
function => \&editHome,
seclev => 1,
formname => $formname,
checks => [ qw (generate_formkey) ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'home',
},
editcomm => {
function => \&editComm,
seclev => 1,
formname => $formname,
checks => [ qw (generate_formkey) ],
tab_selected_1 => 'preferences',
tab_selected_2 => 'comments',
},
# newuser => {
# function => \&newUser,
# seclev => 0,
# formname => "${formname}/nu",
# checks => [ qw (max_post_check valid_check
# formkey_check regen_formkey) ],
# },
newuseradmin => {
function => \&newUserForm,
seclev => 10000,
formname => "${formname}/nu",
checks => [],
},
previewbox => {
function => \&previewSlashbox,
seclev => 0,
formname => $formname,
checks => [],
},
# mailpasswd => {
# function => \&mailPasswd,
# seclev => 0,
# formname => "${formname}/mp",
# checks => [ qw (max_post_check valid_check
# interval_check formkey_check ) ],
# tab_selected_1 => 'preferences',
# tab_selected_2 => 'password',
# },
validateuser => {
function => \&validateUser,
seclev => 1,
formname => $formname,
checks => ['regen_formkey'],
},
showtags => {
function => \&showTags,
seclev => 1,
formname => $formname,
checks => [],
tab_selected => 'tags',
},
showbookmarks => {
function => \&showBookmarks,
seclev => 0,
formname => $formname,
checks => [],
tab_selected => 'bookmarks',
},
edittags => {
function => \&editTags,
seclev => 1,
formname => $formname,
checks => [],
tab_selected => 'tags',
},
savetags => {
function => \&saveTags,
seclev => 1,
formname => $formname,
checks => [],
tab_selected => 'tags',
},
# userclose => {
# function => \&displayForm,
# seclev => 0,
# formname => $formname,
# checks => [],
# },
# newuserform => {
# function => \&displayForm,
# seclev => 0,
# formname => "${formname}/nu",
# checks => [ qw (max_post_check
# generate_formkey) ],
# },
# mailpasswdform => {
# function => \&displayForm,
# seclev => 0,
# formname => "${formname}/mp",
# checks => [ qw (max_post_check
# generate_formkey) ],
# tab_selected_1 => 'preferences',
# tab_selected_2 => 'password',
# },
displayform => {
function => \&displayForm,
seclev => 0,
formname => $formname,
checks => [ qw (generate_formkey) ],
tab_selected_1 => 'me',
},
listreadonly => {
function => \&listReadOnly,
seclev => 100,
formname => $formname,
checks => [],
adminmenu => 'security',
tab_selected => 'readonly',
},
listbanned => {
function => \&listBanned,
seclev => 100,
formname => $formname,
checks => [],
adminmenu => 'security',
tab_selected => 'banned',
},
topabusers => {
function => \&topAbusers,
seclev => 100,
formname => $formname,
checks => [],
adminmenu => 'security',
tab_selected => 'abusers',
},
listabuses => {
function => \&listAbuses,
seclev => 100,
formname => $formname,
checks => [],
},
force_acct_verify => {
function => \&forceAccountVerify,
seclev => 100,
post => 1,
formname => $formname,
checks => []
}
} ;
# Note this is NOT the default op. "userlogin" or "userinfo" is
# the default op, and it's set either 5 lines down or about 100
# lines down, depending. Yes, that's dumb. Yes, we should
# change it. It would require tracing through a fair bit of logic
# though and I don't have the time right now. - Jamie
$ops->{default} = $ops->{displayform};
for (qw(newuser newuserform mailpasswd mailpasswdform changepasswd savepasswd userlogin userclose)) {
$ops->{$_} = $ops->{default};
}
my $errornote = "";
if ($form->{op} && ! defined $ops->{$op}) {
$errornote .= getError('bad_op', { op => $form->{op}}, 0, 1);
$op = $user->{is_anon} ? 'userlogin' : 'userinfo';
}
if ($op eq 'userlogin' && ! $user->{is_anon}) {
redirect(cleanRedirectUrl($form->{returnto} || ''));
return;
# this will only redirect if it is a section-based rootdir with
# its rootdir different from real_rootdir
} elsif ($op eq 'userclose' && $gSkin->{rootdir} ne $constants->{real_rootdir}) {
redirect($constants->{real_rootdir} . '/login.pl?op=userclose');
return;
} elsif ($op =~ /^(?:newuser|newuserform|mailpasswd|mailpasswdform|changepasswd|savepasswd|userlogin|userclose|displayform)$/) {
my $op = $form->{op};
$op = 'changeprefs' if $op eq 'changepasswd';
$op = 'saveprefs' if $op eq 'savepasswd';
redirect($constants->{real_rootdir} . '/login.pl?op=' . $op);
return;
# never get here now
} elsif ($op eq 'savepasswd') {
my $error_flag = 0;
if ($user->{seclev} < 100) {
for my $check (@{$ops->{savepasswd}{checks}}) {
# the only way to save the error message is to pass by ref
# $errornote and add the message to note (you can't print
# it out before header is called)
$error_flag = formkeyHandler($check, $formname, $formkey, \$errornote);
last if $error_flag;
}
}
if (! $error_flag) {
$error_flag = savePasswd({ noteref => \$errornote }) ;
}
# change op to edituser and let fall through;
# we need to have savePasswd set the cookie before
# header() is called -- pudge
if ($user->{seclev} < 100 && ! $error_flag) {
$slashdb->updateFormkey($formkey, length($ENV{QUERY_STRING}));
}
$op = $error_flag ? 'changepasswd' : 'userinfo';
$form->{userfield} = $user->{uid};
}
# Figure out what the op really is.
$op = 'userinfo' if (! $form->{op} && ($form->{uid} || $form->{nick}));
$op ||= $user->{is_anon} ? 'userlogin' : 'userinfo';
if ($user->{is_anon} && ( ($ops->{$op}{seclev} > 0) || ($op =~ /^newuserform|mailpasswdform|displayform$/) )) {
redirect($constants->{real_rootdir} . '/login.pl');
return;
} elsif ($user->{seclev} < $ops->{$op}{seclev}) {
$op = 'userinfo';
}
if ($ops->{$op}{post} && !$postflag) {
$op = $user->{is_anon} ? 'default' : 'userinfo';
}
# Print the header and very top stuff on the page. We have
# three ops that (may) end up routing into showInfo(), which
# needs to do some stuff before it calls header(), so for
# those three, don't bother.
my $header;
if ($op !~ /^(userinfo|display|saveuseradmin|admin|userfirehose$)/) {
my $data = {
adminmenu => $ops->{$op}{adminmenu} || 'admin',
tab_selected => $ops->{$op}{tab_selected},
};
header(getMessage('user_header'), '', $data) or return;
# This is a hardcoded position, bad idea and should be fixed -Brian
# Yeah, we should pull this into a template somewhere...
print getMessage('note', { note => $errornote }) if defined $errornote;
$header = 1;
}
if ($constants->{admin_formkeys} || $user->{seclev} < 100) {
my $done = 0;
$done = 1 if $op eq 'savepasswd'; # special case
$formname = $ops->{$op}{formname};
# No need for HumanConf if the constant for it is not
# switched on, or if the user's karma is high enough
# to get out of it. (But for "newuserform," the current
# user's karma doesn't get them out of having to prove
# they're a human for creating a *new* user.)
my $options = {};
if ( !$constants->{plugin}{HumanConf}
|| !$constants->{hc}
|| !$constants->{hc_sw_newuser}
&& ($formname eq 'users/nu' || $op eq 'newuserform')
|| !$constants->{hc_sw_mailpasswd}
&& ($formname eq 'users/mp' || $op eq 'mailpasswdform')
|| $user->{karma} > $constants->{hc_maxkarma}
&& !$user->{is_anon}
&& !($op eq 'newuser' || $op eq 'newuserform')
) {
$options->{no_hc} = 1;
}
DO_CHECKS: while (!$done) {
for my $check (@{$ops->{$op}{checks}}) {
$ops->{$op}{update_formkey} = 1 if $check eq 'formkey_check';
$error_flag = formkeyHandler($check, $formname, $formkey,
undef, $options);
if ($error_flag == -1) {
# Special error: HumanConf failed. Go
# back to the previous op, start over.
if ($op =~ /^(newuser|mailpasswd)$/) {
$op .= "form";
$error_flag = 0;
next DO_CHECKS;
}
} elsif ($error_flag) {
$done = 1;
last;
}
}
$done = 1;
}
if (!$error_flag && !$options->{no_hc}) {
my $hc = getObject("Slash::HumanConf");
$hc->reloadFormkeyHC($formname) if $hc;
}
}
errorLog("users.pl error_flag '$error_flag'") if $error_flag;
# call the method
my $retval;
$retval = $ops->{$op}{function}->({
op => $op,
tab_selected_1 => $ops->{$op}{tab_selected_1} || "",
note => $errornote,
}) if !$error_flag;
return if !$retval;
if ($op eq 'mailpasswd' && $retval) {
$ops->{$op}{update_formkey} = 0;
}
if ($ops->{$op}{update_formkey} && $user->{seclev} < 100 && ! $error_flag) {
# successful save action, no formkey errors, update existing formkey
# why assign to an unused variable? -- pudge
my $updated = $slashdb->updateFormkey($formkey, length($ENV{QUERY_STRING}));
}
# if there were legit error levels returned from the save methods
# I would have it clear the formkey in case of an error, but that
# needs to be sorted out later
# else { resetFormkey($formkey); }
writeLog($user->{nickname});
footer();
}
#################################################################
sub checkList {
my($string, $len) = @_;
my $constants = getCurrentStatic();
$string =~ s/[^\w,-]//g;
my @items = grep { $_ } split /,/, $string;
$string = join ",", @items;
$len ||= $constants->{checklist_length} || 255;
if (length($string) > $len) {
print getError('checklist_err');
$string = substr($string, 0, $len);
$string =~ s/,?\w*$//g;
} elsif (length($string) < 1) {
$string = '';
}
return $string;
}
#################################################################
sub previewSlashbox {
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $block = $reader->getBlock($form->{bid}, ['title', 'block', 'url']);
my $is_editable = $user->{seclev} >= 1000;
my $title = getTitle('previewslashbox_title', { blocktitle => $block->{title} });
slashDisplay('previewSlashbox', {
width => '100%',
title => $title,
block => $block,
is_editable => $is_editable,
});
print portalbox($constants->{fancyboxwidth}, $block->{title},
$block->{block}, '', $block->{url});
}
#################################################################
sub newUserForm {
my $user = getCurrentUser();
my $suadmin_flag = $user->{seclev} >= 10000;
my $title = getTitle('newUserForm_title');
slashDisplay('newUserForm', {
title => $title,
suadmin_flag => $suadmin_flag,
});
}
#################################################################
sub newUser {
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $plugins = $slashdb->getDescriptions('plugins');
my $title;
my $suadmin_flag = $user->{seclev} >= 10000 ? 1 : 0;
# Check if User Exists
$form->{newusernick} = nickFix($form->{newusernick});
my $matchname = nick2matchname($form->{newusernick});
if (!$form->{email} || $form->{email} !~ /\@/) {
print getError('email_invalid', 0, 1);
return;
} elsif ($form->{email} ne $form->{email2}) {
print getError('email_do_not_match', 0, 1);
return;
} elsif ($slashdb->existsEmail($form->{email})) {
print getError('emailexists_err', 0, 1);
return;
} elsif ($matchname ne '' && $form->{newusernick} ne '') {
if ($constants->{newuser_portscan}) {
my $is_trusted = $slashdb->checkAL2($user->{srcids}, 'trusted');
if (!$is_trusted) {
my $is_proxy = $slashdb->checkForOpenProxy($user->{hostip});
if ($is_proxy) {
print getError('new user open proxy', {
unencoded_ip => $ENV{REMOTE_ADDR},
port => $is_proxy,
});
return;
}
}
}
my $uid;
my $rootdir = getCurrentSkin('rootdir');
$uid = $slashdb->createUser(
$matchname, $form->{email}, $form->{newusernick}
);
if ($uid) {
my $data = {};
getOtherUserParams($data);
for (qw(tzcode)) {
$data->{$_} = $form->{$_} if defined $form->{$_};
}
$data->{creation_ipid} = $user->{ipid};
$slashdb->setUser($uid, $data) if keys %$data;
$title = getTitle('newUser_title');
$form->{pubkey} = $plugins->{'Pubkey'} ?
strip_nohtml($form->{pubkey}, 1) : '';
print getMessage('newuser_msg', {
suadmin_flag => $suadmin_flag,
title => $title,
uid => $uid
});
if ($form->{newsletter} || $form->{comment_reply} || $form->{headlines}) {
my $messages = getObject('Slash::Messages');
my %params;
$params{MSG_CODE_COMMENT_REPLY()} = MSG_MODE_EMAIL()
if $form->{comment_reply};
$params{MSG_CODE_NEWSLETTER()} = MSG_MODE_EMAIL()
if $form->{newsletter};
$params{MSG_CODE_HEADLINES()} = MSG_MODE_EMAIL()
if $form->{headlines};
$messages->setPrefs($uid, \%params);
}
mailPasswd({ uid => $uid });
return;
} else {
$slashdb->resetFormkey($form->{formkey});
print getError('duplicate_user', {
nick => $form->{newusernick},
});
return;
}
} else {
print getError('duplicate_user', {
nick => $form->{newusernick},
});
return;
}
}
#################################################################
sub mailPasswd {
my($hr) = @_;
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $uid = $hr->{uid} || 0;
my $slashdb = getCurrentDB();
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $form = getCurrentForm();
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
if (! $uid) {
if ($form->{unickname} =~ /\@/) {
$uid = $slashdb->getUserEmail($form->{unickname});
} elsif ($form->{unickname} =~ /^\d+$/) {
my $tmpuser = $slashdb->getUser($form->{unickname}, ['uid']);
$uid = $tmpuser->{uid};
} else {
$uid = $slashdb->getUserUID($form->{unickname});
}
}
my $user_edit;
my $err_name = '';
my $err_opts = {};
if (!$uid || isAnon($uid)) {
$err_name = 'mailpasswd_notmailed_err';
}
if (!$err_name) {
# Check permissions of _this_ user, not the target
# user, to determine whether this IP is OK'd to
# send the mail to the target user.
# XXXSRCID This should check a separate field like
# 'openproxy' instead of piggybacking off of the
# existing nopost and spammer
my $srcids_to_check = $user->{srcids};
$err_name = 'mailpasswd_readonly_err'
if $reader->checkAL2($srcids_to_check, 'nopost');
}
if (!$err_name) {
$err_name = 'mailpasswd_toooften_err'
if $slashdb->checkMaxMailPasswords($user_edit);
}
if (!$err_name) {
if ($constants->{mailpasswd_portscan}) {
my $is_trusted = $slashdb->checkAL2($user->{srcids}, 'trusted');
if (!$is_trusted) {
my $is_proxy = $slashdb->checkForOpenProxy($user->{hostip});
if ($is_proxy) {
$err_name = 'mailpasswd open proxy';
$err_opts = { unencoded_ip => $ENV{REMOTE_ADDR}, port => $is_proxy };
}
}
}
}
if ($err_name) {
print getError($err_name, $err_opts);
$slashdb->resetFormkey($form->{formkey});
$form->{op} = 'mailpasswdform';
displayForm();
return(1);
}
my $newpasswd = $slashdb->getNewPasswd($uid);
my $tempnick = $user_edit->{nickname};
my $emailtitle = getTitle('mailPassword_email_title', {
nickname => $user_edit->{nickname}
}, 1);
# Pull out some data passed in with the request. Only the IP
# number is actually trustworthy, the others could be forged.
# Note that we strip the forgeable ones to make sure there
# aren't any "<>" chars which could fool a stupid mail client
# into parsing a plaintext email as HTML.
my $r = Apache->request;
my $remote_ip = $r->connection->remote_ip;
my $xff = $r->header_in('X-Forwarded-For') || '';
$xff =~ s/\s+/ /g;
$xff = substr(strip_notags($xff), 0, 20);
my $ua = $r->header_in('User-Agent') || '';
$ua =~ s/\s+/ /g;
$ua = substr(strip_attribute($ua), 0, 60);
my $msg = getMessage('mailpasswd_msg', {
newpasswd => $newpasswd,
tempnick => $tempnick,
remote_ip => $remote_ip,
x_forwarded_for => $xff,
user_agent => $ua,
}, 1);
doEmail($uid, $emailtitle, $msg) if $user_edit->{nickname};
print getMessage('mailpasswd_mailed_msg', { name => $user_edit->{nickname} });
$slashdb->setUserMailPasswd($user_edit);
}
#################################################################
sub showSubmissions {
my($hr) = @_;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $form = getCurrentForm();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my($uid, $nickname);
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
if ($form->{uid} or $form->{nick}) {
$uid = $form->{uid} || $reader->getUserUID($form->{nick});
$nickname = $reader->getUser($uid, 'nickname');
} else {
$nickname = $user->{nickname};
$uid = $user->{uid};
}
my $storycount = $reader->countStoriesBySubmitter($uid);
my $stories = $reader->getStoriesBySubmitter(
$uid,
$constants->{user_submitter_display_default}
) unless !$storycount;
slashDisplay('userSub', {
nick => $nickname,
uid => $uid,
nickmatch_flag => ($user->{uid} == $uid ? 1 : 0),
stories => $stories,
storycount => $storycount,
});
}
#################################################################
sub showComments {
my($hr) = @_;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $form = getCurrentForm();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $commentstruct = [];
my($uid, $nickname);
my $user_edit;
if ($form->{uid} || $form->{nick}) {
$uid = $form->{uid} || $reader->getUserUID($form->{nick});
$user_edit = $reader->getUser($uid);
} else {
$uid = $user->{uid};
$user_edit = $user;
}
$nickname = $user_edit->{nickname};
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $user_edit->{uid} == $user->{uid} ? 'me' : 'otheruser',
});
my $min_comment = $form->{min_comment} || 0;
$min_comment = 0 unless $user->{seclev} > $constants->{comments_more_seclev}
|| $constants->{comments_more_seclev} == 2 && $user->{is_subscriber};
my $comments_wanted = $user->{show_comments_num}
|| $constants->{user_comment_display_default};
my $commentcount = $reader->countCommentsByUID($uid);
my $comments = $reader->getCommentsByUID(
$uid, $comments_wanted, $min_comment
) if $commentcount;
if (ref($comments) eq 'ARRAY') {
my $kinds = $reader->getDescriptions('discussion_kinds');
for my $comment (@$comments) {
# This works since $sid is numeric.
$comment->{replies} = $reader->countCommentsBySidPid($comment->{sid}, $comment->{cid});
# This is ok, since with all luck we will not be hitting the DB
# ...however, the "sid" parameter here must be the string
# based SID from either the "stories" table or from
# pollquestions.
my $discussion = $reader->getDiscussion($comment->{sid});
if ($kinds->{ $discussion->{dkid} } =~ /^journal(?:-story)?$/) {
$comment->{type} = 'journal';
} elsif ($kinds->{ $discussion->{dkid} } eq 'poll') {
$comment->{type} = 'poll';
} else {
$comment->{type} = 'story';
}
$comment->{disc_title} = $discussion->{title};
$comment->{url} = $discussion->{url};
}
}
my $mod_reader = getObject("Slash::$constants->{m1_pluginname}", { db_type => 'reader' });
slashDisplay('userCom', {
nick => $nickname,
useredit => $user_edit,
nickmatch_flag => ($user->{uid} == $uid ? 1 : 0),
commentstruct => $comments,
commentcount => $commentcount,
min_comment => $min_comment,
reasons => $mod_reader->getReasons(),
karma_flag => 0,
admin_flag => $user->{is_admin},
});
}
sub noUser {
print getData("no_user");
}
sub showFireHose {
my($hr) = @_;
my $user = getCurrentUser();
my $form = getCurrentForm();
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $uid = $form->{uid} || $user->{uid};
my $user_edit = $reader->getUser($uid);
$user->{state}{firehose_page} = "user";
$user->{state}{firehose_user_uid} = $uid;
my $firehose = getObject("Slash::FireHose");
header(getMessage('userfirehose_header', { useredit => $user_edit })) or return;
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $user_edit->{uid} == $user->{uid} ? 'me' : 'otheruser',
});
$form->{mode} = "full";
$form->{color} = "black";
$form->{orderby} = "createtime";
$form->{orderdir} = "DESC";
$form->{skipmenu} = 1;
$form->{duration} = -1;
$form->{fhfilter} = "\"user:$user_edit->{nickname}\"";
$form->{pause} = 1;
$form->{listonly} = 1;
$form->{legacy} = 1;
my $fhbox = $firehose->listView({ fh_page => 'users.pl', tab => 'userfirehose', user_view => $user_edit });
slashDisplay("userFireHose", { firehosebox => $fhbox, uid => $uid, useredit => $user_edit });
}
#################################################################
# arhgghgh. I love torture. I love pain. This subroutine satisfies
# these needs of mine
sub showInfo {
my($hr) = @_;
my $id = $hr->{uid} || 0;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $admin_flag = ($user->{is_admin}) ? 1 : 0;
my $suadmin_flag = $user->{seclev} >= 10000 ? 1 : 0;
my($title, $admin_block, $fieldkey) = ('', '', '');
my $comments = undef;
my $commentcount = 0;
my $commentcount_time = 0;
my $commentstruct = [];
my $requested_user = {};
my $time_period = $constants->{admin_comment_display_days} || 30;
my $cid_for_time_period = $reader->getVar("min_cid_last_$time_period\_days",'value', 1) || 0;
my $admin_time_period_limit = $constants->{admin_daysback_commentlimit} || 100;
my $admin_non_time_limit = $constants->{admin_comment_subsequent_pagesize} || 24;
my($points, $nickmatch_flag, $uid, $nick);
my($mod_flag, $karma_flag, $n) = (0, 0, 0);
if ($admin_flag
&& (defined($form->{show_m2s}) || defined($form->{show_m1s}) || defined($form->{m2_listing})))
{
my $update_hr = {};
$update_hr->{mod_with_comm} = $form->{show_m1s}
if defined $form->{show_m1s};
$update_hr->{m2_with_mod} = ($constants->{m2} ? $form->{show_m2s} : undef)
if defined $form->{show_m2s};
$update_hr->{show_m2_listing} = ($constants->{m2} ? $form->{m2_listing} : undef)
if defined $form->{m2_listing};
$slashdb->setUser($user->{uid}, $update_hr);
}
if (!$id && !$form->{userfield}) {
if ($form->{uid} && ! $id) {
$fieldkey = 'uid';
($uid, $id) = ($form->{uid}, $form->{uid});
$requested_user = isAnon($uid) ? $user : $reader->getUser($id);
$nick = $requested_user->{nickname};
$form->{userfield} = $nick if $admin_flag;
} elsif ($form->{nick} && ! $id) {
$fieldkey = 'nickname';
($nick, $id) = ($form->{nick}, $form->{nick});
$uid = $reader->getUserUID($id);
if (isAnon($uid)) {
$requested_user = $user;
($nick, $uid, $id) = @{$user}{qw(nickname uid nickname)};
} else {
$requested_user = $reader->getUser($uid);
}
$form->{userfield} = $uid if $admin_flag;
} else {
$fieldkey = 'uid';
($id, $uid) = ($user->{uid}, $user->{uid});
$requested_user = $reader->getUser($uid);
$form->{userfield} = $uid if $admin_flag;
}
} elsif ($user->{is_admin}) {
$id ||= $form->{userfield} || $user->{uid};
if ($id =~ /^[0-9a-f]{16}$/) {
$requested_user->{nonuid} = 1;
$fieldkey = "srcid";
$requested_user->{$fieldkey} = $id;
} elsif ($id =~ /^\d+$/) {
# If it's longer than a uid could possibly be, it
# must be a srcid. The uid column right now is a
# MEDIUMINT (max 16M) but at most might someday
# be an INT (max 4G).
if (length($id) > 11) {
$requested_user->{nonuid} = 1;
$fieldkey = "srcid";
$requested_user->{$fieldkey} = $id;
} else {
$fieldkey = 'uid';
$requested_user = $reader->getUser($id);
$uid = $requested_user->{uid};
$nick = $requested_user->{nickname};
if ((my $conflict_id = $reader->getUserUID($id)) && $form->{userinfo}) {
slashDisplay('showInfoConflict', {
op => 'userinfo',
id => $uid,
nick => $nick,
conflict_id => $conflict_id
});
return 1;
}
}
} elsif (length($id) == 32) {
$requested_user->{nonuid} = 1;
if ($form->{fieldname}
&& $form->{fieldname} =~ /^(ipid|subnetid)$/) {
$fieldkey = $form->{fieldname};
} else {
$fieldkey = 'md5id';
}
$requested_user->{$fieldkey} = $id;
} elsif ($id =~ /^(\d{1,3}\.\d{1,3}.\d{1,3}\.0)$/
|| $id =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3})\.?$/) {
$fieldkey = 'subnetid';
$requested_user->{subnetid} = $1;
$requested_user->{subnetid} .= '.0' if $requested_user->{subnetid} =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}$/;
$requested_user->{nonuid} = 1;
$requested_user->{subnetid} = md5_hex($requested_user->{subnetid});
} elsif ($id =~ /^([\d+\.]+)$/) {
$fieldkey = 'ipid';
$requested_user->{nonuid} = 1;
$id ||= $1;
$requested_user->{ipid} = md5_hex($1);
} elsif ($id =~ /^(.*@.*\..*?)$/) {
# check for email addy, but make it by uid
$fieldkey = 'uid';
$id = $uid = $reader->getUserEmail($id);
$requested_user = $reader->getUser($uid);
$nick = $requested_user->{nickname};
} else { # go by nickname, but make it by uid
$fieldkey = 'uid';
$id = $uid = $reader->getUserUID($id);
$requested_user = $reader->getUser($uid);
$nick = $requested_user->{nickname};
}
} else {
$fieldkey = 'uid';
($id, $uid) = ($user->{uid}, $user->{uid});
$requested_user = $reader->getUser($uid);
}
# Can't get user data for the anonymous user.
if ($fieldkey eq 'uid' && isAnon($uid)) {
header(getMessage('user_header')) or return;
return displayForm();
}
my $user_change = { };
if ($fieldkey eq 'uid' && !$user->{is_anon}
&& $uid != $user->{uid} && !isAnon($uid)) {
# Store the fact that this user last looked at that user.
# For maximal convenience in stalking.
$user_change->{lastlookuid} = $uid;
$user_change->{lastlooktime} = time;
$user->{lastlookuid} = $uid;
$user->{lastlooktime} = time;
$hr->{tab_selected_1} = 'otheruser';
}
# showInfo's header information is delayed until here, because
# the target user's info is not available until here.
vislenify($requested_user);
header(getMessage('user_header', { useredit => $requested_user, fieldkey => $fieldkey })) or return;
# This is a hardcoded position, bad idea and should be fixed -Brian
# Yeah, we should pull this into a template somewhere...
print getMessage('note', { note => $hr->{note} }) if defined $hr->{note};
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $comments_wanted = $user->{show_comments_num}
|| $constants->{user_comment_display_default};
my $min_comment = $form->{min_comment} || 0;
$min_comment = 0 unless $user->{seclev} > $constants->{comments_more_seclev}
|| $constants->{comments_more_seclev} == 2 && $user->{is_subscriber};
my($netid, $netid_vis) = ('', '');
my $comment_time;
my $non_admin_limit = $comments_wanted;
if ($requested_user->{nonuid}) {
$requested_user->{fg} = $user->{fg};
$requested_user->{bg} = $user->{bg};
if ($requested_user->{ipid}) {
$netid = $requested_user->{ipid} ;
} elsif ($requested_user->{md5id}) {
$netid = $requested_user->{md5id} ;
} elsif ($requested_user->{srcid}) {
$netid = $requested_user->{srcid} ;
} else {
$netid = $requested_user->{subnetid} ;
}
my $data = {
id => $id,
md5id => $netid,
};
vislenify($data); # add $data->{md5id_vis}
$netid_vis = $data->{md5id_vis};
$title = getTitle('user_netID_user_title', $data);
$admin_block = getUserAdmin($netid, $fieldkey, 0) if $admin_flag;
if ($form->{fieldname}) {
if ($form->{fieldname} eq 'ipid') {
$commentcount = $reader->countCommentsByIPID($netid);
$commentcount_time = $reader->countCommentsByIPID($netid, { cid_at_or_after => $cid_for_time_period });
$comments = getCommentListing("ipid", $netid,
$min_comment, $time_period, $commentcount, $commentcount_time, $cid_for_time_period,
$non_admin_limit, $admin_time_period_limit, $admin_non_time_limit)
if $commentcount;
} elsif ($form->{fieldname} eq 'subnetid') {
$commentcount = $reader->countCommentsBySubnetID($netid);
$commentcount_time = $reader->countCommentsBySubnetID($netid, { cid_at_or_after => $cid_for_time_period });
$comments = getCommentListing("subnetid", $netid,
$min_comment, $time_period, $commentcount, $commentcount_time, $cid_for_time_period,
$non_admin_limit, $admin_time_period_limit, $admin_non_time_limit)
if $commentcount;
} else {
delete $form->{fieldname};
}
}
if (!defined($comments)) {
# Last resort; here for backwards compatibility mostly.
my $type;
($commentcount,$type) = $reader->countCommentsByIPIDOrSubnetID($netid);
$commentcount_time = $reader->countCommentsByIPIDOrSubnetID($netid, { cid_at_or_after => $cid_for_time_period });
if ($type eq "ipid") {
$comments = getCommentListing("ipid", $netid,
$min_comment, $time_period, $commentcount, $commentcount_time, $cid_for_time_period,
$non_admin_limit, $admin_time_period_limit, $admin_non_time_limit)
if $commentcount;
} elsif ($type eq "subnetid") {
$comments = getCommentListing("subnetid", $netid,
$min_comment, $time_period, $commentcount, $commentcount_time, $cid_for_time_period,
$non_admin_limit, $admin_time_period_limit, $admin_non_time_limit)
if $commentcount;
}
}
} else {
$admin_block = getUserAdmin($id, $fieldkey, 1) if $admin_flag;
$commentcount = $reader->countCommentsByUID($requested_user->{uid});
$commentcount_time = $reader->countCommentsByUID($requested_user->{uid}, { cid_at_or_after => $cid_for_time_period });
$comments = getCommentListing("uid", $requested_user->{uid},
$min_comment, $time_period, $commentcount, $commentcount_time, $cid_for_time_period,
$non_admin_limit, $admin_time_period_limit, $admin_non_time_limit,
{ use_uid_cid_cutoff => 1 })
if $commentcount;
$netid = $requested_user->{uid};
}
# Grab the nicks of the uids we have, we're going to be adding them
# into the struct.
my @users_extra_cols_wanted = qw( nickname );
my @discussions_extra_cols_wanted = qw( type );
my $uid_hr = { };
my $sid_hr = { };
if ($comments && @$comments) {
my %uids = ();
my %sids = ();
for my $c (@$comments) {
$uids{$c->{uid}}++;
$sids{$c->{sid}}++;
}
my $uids = join(", ", sort { $a <=> $b } keys %uids);
my $sids = join(", ", sort { $a <=> $b } keys %sids);
$uid_hr = $reader->sqlSelectAllHashref(
"uid",
"uid, " . join(", ", @users_extra_cols_wanted),
"users",
"uid IN ($uids)"
);
$sid_hr = $reader->sqlSelectAllHashref(
"id",
"id, " . join(", ", @discussions_extra_cols_wanted),
"discussions",
"id IN ($sids)"
);
}
my $cids_seen = {};
my $kinds = $slashdb->getDescriptions('discussion_kinds');
for my $comment (@$comments) {
$cids_seen->{$comment->{cid}}++;
my $type;
# This works since $sid is numeric.
my $replies = $reader->countCommentsBySidPid($comment->{sid}, $comment->{cid});
# This is cached.
my $discussion = $reader->getDiscussion($comment->{sid});
#use Data::Dumper; if ($discussion && !$discussion->{dkid}) { print STDERR scalar(gmtime) . " users.pl discussion but no dkid: " . Dumper($discussion) }
if (!$discussion || !$discussion->{dkid}) {
# A comment with no accompanying discussion;
# basically we pretend it doesn't exist.
next;
} elsif ($kinds->{ $discussion->{dkid} } =~ /^journal(?:-story)?$/) {
$type = 'journal';
} elsif ($kinds->{ $discussion->{dkid} } eq 'poll') {
$type = 'poll';
} else {
$type = 'story';
}
$comment->{points} += $user->{karma_bonus}
if $user->{karma_bonus} && $comment->{karma_bonus} eq 'yes';
$comment->{points} += $user->{subscriber_bonus}
if $user->{subscriber_bonus} && $comment->{subscriber_bonus} eq 'yes';
# fix points in case they are out of bounds
$comment->{points} = $constants->{comment_minscore} if $comment->{points} < $constants->{comment_minscore};
$comment->{points} = $constants->{comment_maxscore} if $comment->{points} > $constants->{comment_maxscore};
vislenify($comment);
my $data = {
pid => $comment->{pid},
url => $discussion->{url},
disc_type => $type,
disc_title => $discussion->{title},
disc_time => $discussion->{ts},
sid => $comment->{sid},
cid => $comment->{cid},
subj => $comment->{subject},
cdate => $comment->{date},
pts => $comment->{points},
reason => $comment->{reason},
uid => $comment->{uid},
replies => $replies,
ipid => $comment->{ipid},
ipid_vis => $comment->{ipid_vis},
karma => $comment->{karma},
tweak => $comment->{tweak},
tweak_orig => $comment->{tweak_orig},
};
#Karma bonus time
for my $col (@users_extra_cols_wanted) {
$data->{$col} = $uid_hr->{$comment->{uid}}{$col} if defined $uid_hr->{$comment->{uid}}{$col};
}
for my $col(@discussions_extra_cols_wanted) {
$data->{$col} = $sid_hr->{$comment->{sid}}{$col} if defined $sid_hr->{$comment->{sid}}{$col};
}
push @$commentstruct, $data;
}
# if (grep { !defined($_->{disc_time}) || !defined($_->{sid}) } @$commentstruct) { use Data::Dumper; print STDERR "showInfo undef in commentstruct for id=$id: " . Dumper($commentstruct) }
# Sort so the chosen group of comments is sorted by discussion
@$commentstruct = sort {
$b->{disc_time} cmp $a->{disc_time} || $b->{sid} <=> $a->{sid}
} @$commentstruct
unless $user->{user_comment_sort_type} && $user->{user_comment_sort_type} == 1;
my $cid_list = [ keys %$cids_seen ];
my $cids_to_mods = {};
my $mod_reader = getObject("Slash::$constants->{m1_pluginname}", { db_type => 'reader' });
if ($constants->{m1} && $admin_flag && $constants->{show_mods_with_comments}) {
my $comment_mods = $mod_reader->getModeratorCommentLog("DESC",
$constants->{mod_limit_with_comments}, "cidin", $cid_list);
# Loop through mods and group them by the sid they're attached to
while (my $mod = shift @$comment_mods) {
push @{$cids_to_mods->{$mod->{cid}}}, $mod;
}
}
my $sub_limit = ((($admin_flag || $user->{uid} == $requested_user->{uid}) ? $constants->{submissions_all_page_size} : $constants->{submissions_accepted_only_page_size}) || "");
my $sub_options = { limit_days => 365 };
$sub_options->{accepted_only} = 1 if !$admin_flag && $user->{uid} != $requested_user->{uid};
my $sub_field = $form->{fieldname};
my ($subcount, $ret_field) = $reader->countSubmissionsByNetID($netid, $sub_field)
if $requested_user->{nonuid};
my $submissions = $reader->getSubmissionsByNetID($netid, $ret_field, $sub_limit, $sub_options)
if $requested_user->{nonuid};
my $ipid_hoursback = $constants->{istroll_ipid_hours} || 72;
my $uid_hoursback = $constants->{istroll_uid_hours} || 72;
if ($requested_user->{nonuid}) {
slashDisplay('netIDInfo', {
title => $title,
id => $id,
useredit => $requested_user,
commentstruct => $commentstruct || [],
commentcount => $commentcount,
min_comment => $min_comment,
admin_flag => $admin_flag,
admin_block => $admin_block,
netid => $netid,
netid_vis => $netid_vis,
reasons => $mod_reader->getReasons(),
subcount => $subcount,
submissions => $submissions,
hr_hours_back => $ipid_hoursback,
cids_to_mods => $cids_to_mods,
comment_time => $comment_time
});
} else {
if (! $requested_user->{uid}) {
print getError('userinfo_idnf_err', { id => $id, fieldkey => $fieldkey});
return 1;
}
$karma_flag = 1 if $admin_flag;
$requested_user->{nick_plain} = $nick ||= $requested_user->{nickname};
$nick = strip_literal($nick);
if ($requested_user->{uid} == $user->{uid}) {
$karma_flag = 1;
$nickmatch_flag = 1;
$points = $requested_user->{points};
$mod_flag = 1 if $points > 0;
$title = getTitle('userInfo_main_title', { nick => $nick, uid => $uid });
} else {
$title = getTitle('userInfo_user_title', { nick => $nick, uid => $uid });
}
my $lastjournal = _get_lastjournal($uid);
my $subcount = $reader->countSubmissionsByUID($uid);
my $submissions = $reader->getSubmissionsByUID($uid, $sub_limit, $sub_options);
my $metamods;
if ($constants->{m2} && $admin_flag) {
my $metamod_reader = getObject('Slash::Metamod', { db_type => 'reader' });
$metamods = $metamod_reader->getMetamodlogForUser($uid, 30);
}
my $tags_reader = getObject('Slash::Tags', { db_type => 'reader' });
my $tagshist = [];
if ($tags_reader && $user->{is_admin}) {
$tagshist = $tags_reader->getAllTagsFromUser($requested_user->{uid}, { orderby => 'created_at', orderdir => 'DESC', limit => 30, include_private => 1 });
}
slashDisplay('userInfo', {
title => $title,
uid => $uid,
useredit => $requested_user,
points => $points,
commentstruct => $commentstruct || [],
commentcount => $commentcount,
min_comment => $min_comment,
nickmatch_flag => $nickmatch_flag,
mod_flag => $mod_flag,
karma_flag => $karma_flag,
admin_block => $admin_block,
admin_flag => $admin_flag,
suadmin_flag => $suadmin_flag,
reasons => $mod_reader->getReasons(),
lastjournal => $lastjournal,
hr_hours_back => $ipid_hoursback,
cids_to_mods => $cids_to_mods,
comment_time => $comment_time,
submissions => $submissions,
subcount => $subcount,
metamods => $metamods,
tagshist => $tagshist
});
}
if ($user_change && %$user_change) {
$slashdb->setUser($user->{uid}, $user_change);
}
return 1;
}
sub _get_lastjournal {
my($uid) = @_;
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $lastjournal = undef;
if (my $journal = getObject('Slash::Journal', { db_type => 'reader' })) {
my $j = $journal->getsByUid($uid, 0, 1);
if ($j && @$j) {
# Yep, there are 1 or more journals... get the first.
$j = $j->[0];
}
if ($j && @$j) {
# Yep, that first journal exists and has entries...
# convert from stupid numeric array to a hashref.
my @field = qw( date article description id
posttype tid discussion );
$lastjournal = { };
for my $i (0..$#field) {
$lastjournal->{$field[$i]} = $j->[$i];
}
}
}
if ($lastjournal) {
# Strip the article field for display.
$lastjournal->{article} = strip_mode($lastjournal->{article},
$lastjournal->{posttype});
# For display, include a reduced-size version, where the
# size is based on the user's maxcomment size (which
# defaults to 4K) and can't have too many line-breaking
# tags.
my $art_shrunk = $lastjournal->{article};
my $maxsize = int($constants->{default_maxcommentsize} / 25);
$maxsize = 80 if $maxsize < 80;
$maxsize = 600 if $maxsize > 600;
$art_shrunk = chopEntity($art_shrunk, $maxsize);
my $approvedtags_break = $constants->{approvedtags_break} || [];
my $break_tag = join '|', @$approvedtags_break;
if (scalar(() = $art_shrunk =~ /<(?:$break_tag)>/gi) > 2) {
$art_shrunk =~ s/\A
(
(?: <(?:$break_tag)> )?
.*? <(?:$break_tag)>
.*?
) <(?:$break_tag)>.*
/$1/six;
if (length($art_shrunk) < 15) {
# This journal entry has too much whitespace
# in its first few chars; scrap it.
undef $art_shrunk;
}
$art_shrunk = chopEntity($art_shrunk) if defined($art_shrunk);
}
if (defined $art_shrunk) {
if (length($art_shrunk) < length($lastjournal->{article})) {
$art_shrunk .= " ...";
}
$art_shrunk = strip_html($art_shrunk);
$art_shrunk = balanceTags($art_shrunk);
}
$lastjournal->{article_shrunk} = $art_shrunk;
if ($lastjournal->{discussion}) {
$lastjournal->{commentcount} = $reader->getDiscussion(
$lastjournal->{discussion}, 'commentcount');
}
}
return $lastjournal;
}
#####################################################################
sub validateUser {
my($hr) = @_;
my $user = getCurrentUser();
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
# If we aren't expiring accounts in some way, we don't belong here.
if (! allowExpiry()) {
displayForm();
return;
}
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
# Since we are here, if the minimum values for the comment trigger and
# the day trigger are -1, then they should be reset to 1.
$constants->{min_expiry_comm} = $constants->{min_expiry_days} = 1
if $constants->{min_expiry_comm} <= 0 ||
$constants->{min_expiry_days} <= 0;
if ($user->{is_anon} || $user->{registered}) {
if ($user->{is_anon}) {
print getError('anon_validation_attempt');
displayForm();
return;
} else {
print getMessage('no_registration_needed')
if !$user->{reg_id};
showInfo({ uid => $user->{uid} });
return;
}
# Maybe this should be taken care of in a more centralized location?
} elsif ($user->{reg_id} eq $form->{id}) {
# We have a user and the registration IDs match. We are happy!
my($maxComm, $maxDays) = ($constants->{max_expiry_comm},
$constants->{max_expiry_days});
my($userComm, $userDays) =
($user->{user_expiry_comm}, $user->{user_expiry_days});
# Ensure both $userComm and $userDays aren't -1 (expiry has
# just been turned on).
$userComm = $constants->{min_expiry_comm}
if $userComm < $constants->{min_expiry_comm};
$userDays = $constants->{min_expiry_days}
if $userDays < $constants->{min_expiry_days};
my $exp = $constants->{expiry_exponent};
# Increment only the trigger that was used.
my $new_comment_expiry = ($maxComm > 0 && $userComm > $maxComm)
? $maxComm
: $userComm * (($user->{expiry_comm} < 0)
? $exp
: 1
);
my $new_days_expiry = ($maxDays > 0 && $userDays > $maxDays)
? $maxDays
: $userDays * (($user->{expiry_days} < 0)
? $exp
: 1
);
# Reset re-registration triggers for user.
$slashdb->setUser($user->{uid}, {
'expiry_comm' => $new_comment_expiry,
'expiry_days' => $new_days_expiry,
'user_expiry_comm' => $new_comment_expiry,
'user_expiry_days' => $new_days_expiry,
});
# Handles rest of re-registration process.
setUserExpired($user->{uid}, 0);
}
slashDisplay('regResult');
}
#####################################################################
sub editTags {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $note = $hr->{note} || "";
return if $user->{is_anon}; # shouldn't be, but can't hurt to check
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $user_edit = $slashdb->getUser($user->{uid});
my $title = getTitle('editTags_title');
slashDisplay('editTags', {
user_edit => $user_edit,
title => $title,
note => $note,
});
}
sub saveTags {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $constants = getCurrentStatic();
return if $user->{is_anon}; # shouldn't be, but can't hurt to check
$slashdb->setUser($user->{uid}, {
tags_turnedoff => $form->{showtags} ? '' : 1 });
editTags({ note => getMessage('savetags_msg') });
}
#####################################################################
sub showTags {
my($hr) = @_;
my $user = getCurrentUser();
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $tags_reader = getObject('Slash::Tags', { db_type => 'reader' });
# XXX if $user_edit->{acl}{spammer}, either abort or put ref=nofollow in all links
my $tagname = $form->{tagname} || '';
$tagname = '' if !$tags_reader->tagnameSyntaxOK($tagname);
my($uid, $user_edit);
if ($form->{uid} || $form->{nick}) {
$uid = $form->{uid} || $tags_reader->getUserUID($form->{nick});
$user_edit = $tags_reader->getUser($uid);
}
if (!$user_edit || $user_edit->{is_anon}) {
$uid = $user->{uid};
$user_edit = $user;
}
my $nickname = $user_edit->{nickname};
if (!$constants->{plugin}{Tags}) {
print getError('bad_op', { op => $form->{op}});
return;
}
my $tagnameid = $tags_reader->getTagnameidFromNameIfExists($tagname);
if ($tagnameid) {
# Show all user's tags for one particular tagname.
my $tags_hr = $tags_reader->getGroupedTagsFromUser($user_edit->{uid},
{ tagnameid => $tagnameid });
my $tags_ar = $tags_hr->{$tagname} || [ ];
slashDisplay('usertagsforname', {
useredit => $user_edit,
tagname => $tagname,
tags => $tags_ar,
});
} else {
my $tags_hr = $tags_reader->getGroupedTagsFromUser($user_edit->{uid});
my $num_tags = 0;
for my $tn (keys %$tags_hr) {
$num_tags += scalar @{ $tags_hr->{$tn} };
}
my $cutoff = $constants->{tags_usershow_cutoff} || 200;
if ($num_tags <= $cutoff) {
# Show all user's tags, grouped by tagname.
slashDisplay('usertags', {
useredit => $user_edit,
tags_grouped => $tags_hr,
});
} else {
# Show all user's tagnames, with links to show all
# tags for each particular tagname.
my $tagname_ar = [ sort keys %$tags_hr ];
slashDisplay('usertagnames', {
useredit => $user_edit,
tagnames => $tagname_ar,
});
}
}
}
#################################################################
sub showBookmarks {
my($hr) = @_;
my $user = getCurrentUser();
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $tags_reader = getObject('Slash::Tags', { db_type => 'reader' });
my($uid, $user_edit);
if ($form->{uid} || $form->{nick}) {
$uid = $form->{uid} || $tags_reader->getUserUID($form->{nick});
$user_edit = $tags_reader->getUser($uid);
}
if (!$user_edit || $user_edit->{is_anon}) {
$uid = $user->{uid};
$user_edit = $user;
}
my $nickname = $user_edit->{nickname};
if (!$constants->{plugin}{Tags}) {
print getError('bad_op', { op => $form->{op}});
return;
}
my $tags_ar = $tags_reader->getGroupedTagsFromUser($user_edit->{uid}, { type => "urls", only_bookmarked => 1 });
slashDisplay('userbookmarks', {
useredit => $user_edit,
tags_grouped => $tags_ar,
});
}
#################################################################
sub editKey {
my($uid) = @_;
my $slashdb = getCurrentDB();
my $pubkey = $slashdb->getUser($uid, 'pubkey');
my $editkey = slashDisplay('editKey', { pubkey => $pubkey }, 1);
return $editkey;
}
#################################################################
# We arrive here without header() having been called. Some of the
# functions we dispatch to call it, some do not.
sub adminDispatch {
my($hr) = @_;
my $form = getCurrentForm();
my $op = $hr->{op} || $form->{op};
if ($op eq 'authoredit') {
# editUser() does not call header(), so we DO need to.
header(getMessage('user_header'), '', {}) or return;
editUser($hr);
} elsif ($form->{saveuseradmin}) {
# saveUserAdmin() tail-calls showInfo(), which calls
# header(), so we need to NOT.
saveUserAdmin($hr);
} elsif ($form->{userinfo}) {
# showInfo() calls header(), so we need to NOT.
showInfo($hr);
} elsif ($form->{userfield}) {
# none of these calls header(), so we DO need to.
header(getMessage('user_header'), '', {}) or return;
if ($form->{edituser}) {
editUser($hr);
} elsif ($form->{edithome}) {
editHome($hr);
} elsif ($form->{editcomm}) {
editComm($hr);
} elsif ($form->{changepasswd}) {
changePasswd($hr);
}
} else {
# showInfo() calls header(), so we need to NOT.
showInfo($hr);
}
}
#################################################################
sub tildeEd {
my($user_edit) = @_;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $constants = getCurrentStatic();
my %story023_default = (
author => { },
nexus => { },
topic => { },
);
my %prefs = ( );
for my $field (qw(
story_never_topic story_never_author story_never_nexus
story_always_topic story_always_author story_always_nexus story_brief_always_nexus
story_full_brief_nexus story_full_best_nexus story_brief_best_nexus
)) {
for my $id (
grep /^\d+$/,
split /,/,
($user_edit->{$field} || "")
) {
$prefs{$field}{$id} = 1;
}
}
#print STDERR scalar(localtime) . " prefs: " . Dumper(\%prefs);
# Set up $author_hr, @aid_order, and $story023_default{author}.
my $author_hr = $reader->getDescriptions('authors');
my @aid_order = sort { lc $author_hr->{$a} cmp lc $author_hr->{$b} } keys %$author_hr;
for my $aid (@aid_order) {
if ($prefs{story_never_author}{$aid}) {
$story023_default{author}{$aid} = 0;
} elsif ($prefs{story_always_author}{$aid}) {
$story023_default{author}{$aid} = 3;
} else {
$story023_default{author}{$aid} = 2;
}
}
# Set up $topic_hr, @topictid_order, and $story023_default{topic}.
my $topic_hr = $reader->getDescriptions('non_nexus_topics-storypickable');
my @topictid_order = sort { lc $topic_hr->{$a} cmp lc $topic_hr->{$b} } keys %$topic_hr;
for my $tid (@topictid_order) {
if ($prefs{story_never_topic}{$tid}) {
$story023_default{topic}{$tid} = 0;
} elsif ($prefs{story_always_topic}{$tid}) {
$story023_default{topic}{$tid} = 3;
} else {
$story023_default{topic}{$tid} = 2;
}
}
# Set up $nexus_hr, @nexustid_order, and $story023_default{nexus}.
my $topic_tree = $reader->getTopicTree();
my $nexus_tids_ar = $reader->getStorypickableNexusChildren($constants->{mainpage_nexus_tid}, 1);
my $nexus_hr = { };
for my $tid (@$nexus_tids_ar) {
$nexus_hr->{$tid} = $topic_tree->{$tid}{textname};
}
my @nexustid_order = sort {($b == $constants->{mainpage_nexus_tid}) <=> ($a == $constants->{mainpage_nexus_tid}) ||
lc $nexus_hr->{$a} cmp lc $nexus_hr->{$b} } keys %$nexus_hr;
my $mp_disp_nexuses = $reader->getMainpageDisplayableNexuses();
my %mp_disp_nexus = ( map { ($_, 1) } @$mp_disp_nexuses );
for my $tid (@nexustid_order) {
if ($prefs{story_never_nexus}{$tid}) {
$story023_default{nexus}{$tid} = 0;
} elsif ($prefs{story_always_nexus}{$tid}) {
$story023_default{nexus}{$tid} = 5;
} elsif ($prefs{story_full_brief_nexus}{$tid}) {
$story023_default{nexus}{$tid} = 4;
} elsif ($prefs{story_brief_always_nexus}{$tid}) {
$story023_default{nexus}{$tid} = 3;
} elsif ($prefs{story_full_best_nexus}{$tid}) {
$story023_default{nexus}{$tid} = 2;
} elsif ($prefs{story_brief_best_nexus}{$tid}) {
$story023_default{nexus}{$tid} = 1;
} else {
# If brief_sectional_mainpage is set, then all
# nexuses in getMainpageDisplayableNexuses are,
# by default, shown as brief on the mainpage.
if ($constants->{brief_sectional_mainpage}
&& $mp_disp_nexus{$tid}
) {
$story023_default{nexus}{$tid} = 4;
} else {
$story023_default{nexus}{$tid} = 2;
}
}
}
# Set up $section_descref and $box_order, used to decide which
# slashboxes appear. Really this doesn't seem to have anything
# to do with sections, so I'm not sure why it's called
# "section"_descref.
my $section_descref = { };
my $box_order;
my $sections_description = $reader->getSectionBlocks();
# the names of all the boxes in @{$skinBoxes->{$constants->{mainpage_skid}}}
# should be unioned into sections_description. whether the
# values are 0 or 1 is calculated correctly, but we're
# missing some 0's that should appear, I think, under
# some circumstances. ah heck, the whole concept of
# sectional slashboxes should be redone (why the heck
# do we have skinname_more instead of just a block
# called olderstories?)
my $slashboxes_hr = { };
my $slashboxes_textlist = $user_edit->{slashboxes};
if (!$slashboxes_textlist) {
# Use the default.
my($boxes, $skinBoxes) = $reader->getPortalsCommon();
$slashboxes_textlist = join ",", @{$skinBoxes->{$constants->{mainpage_skid}}};
}
for my $bid (
map { /^'?([^']+)'?$/; $1 }
split /,/,
$slashboxes_textlist
) {
$slashboxes_hr->{$bid} = 1;
}
for my $ary (sort { lc $a->[1] cmp lc $b->[1]} @$sections_description) {
my($bid, $title, $boldflag) = @$ary;
push @$box_order, $bid;
$section_descref->{$bid}{checked} =
$slashboxes_hr->{$bid}
? $constants->{markup_checked_attribute}
: '';
$title =~ s/<(.*?)>//g;
$section_descref->{$bid}{title} = $title;
}
my $dynamic_blocks = getObject("Slash::DynamicBlocks");
my $extra_blocks = [];
if ($dynamic_blocks) {
my $userblocks = $dynamic_blocks->getUserBlocks("name", $user_edit->{uid}) || {};
my $friendblocks = $dynamic_blocks->getFriendBlocks("name", $user_edit->{uid}) || {};
push(@$extra_blocks, grep { $slashboxes_textlist =~ $_; } (keys(%$userblocks), keys(%$friendblocks)));
}
# Userspace.
my $userspace = $user_edit->{mylinks} || "";
# Titles of stuff.
my $tildeEd_title = getTitle('tildeEd_title');
my $criteria_msg = getMessage('tilded_criteria_msg');
my $customize_title = getTitle('tildeEd_customize_title');
my $tilded_customize_msg = getMessage('tilded_customize_msg',
{ userspace => $userspace });
my $tilded_box_msg = getMessage('tilded_box_msg');
my $tilde_ed = slashDisplay('tildeEd', {
user_edit => $user_edit,
title => $tildeEd_title,
criteria_msg => $criteria_msg,
customize_title => $customize_title,
tilded_customize_msg => $tilded_customize_msg,
tilded_box_msg => $tilded_box_msg,
story023_default => \%story023_default,
authorref => $author_hr,
aid_order => \@aid_order,
topicref => $topic_hr,
topictid_order => \@topictid_order,
nexusref => $nexus_hr,
nexustid_order => \@nexustid_order,
section_descref => $section_descref,
box_order => $box_order,
userspace => $userspace,
extra_blocks => $extra_blocks,
}, 1);
return $tilde_ed;
}
#################################################################
sub changePasswd {
my($hr) = @_;
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $user_edit = {};
my $title;
my $suadmin_flag = ($user->{seclev} >= 10000) ? 1 : 0;
my $admin_flag = ($user->{is_admin}) ? 1 : 0;
my $admin_block = '';
my $id = '';
if ($admin_flag) {
if ($form->{userfield}) {
$id ||= $form->{userfield};
if ($id =~ /^\d+$/) {
$user_edit = $slashdb->getUser($id);
} else {
$user_edit = $slashdb->getUser($slashdb->getUserUID($id));
}
} else {
$user_edit = $id eq '' ? $user : $slashdb->getUser($id);
$id = $user_edit->{uid};
}
} else {
$id = $user->{uid};
$user_edit = $user;
}
$admin_block = getUserAdmin($id, 'uid', 1) if $admin_flag;
# print getMessage('note', { note => $form->{note}}) if $form->{note};
$title = getTitle('changePasswd_title', { user_edit => $user_edit });
my $session = $slashdb->getDescriptions('session_login');
my $session_select = createSelect('session_login', $session, $user_edit->{session_login}, 1);
my $clocation = $slashdb->getDescriptions('cookie_location');
my @clocation_order = grep { exists $clocation->{$_} } qw(none classbid subnetid ipid);
my $clocation_select = createSelect('cookie_location', $clocation,
$user_edit->{cookie_location}, 1, 0, \@clocation_order
);
my $got_oldpass = 0;
if ($form->{oldpass}) {
my $return_uid = $slashdb->getUserAuthenticate($id, $form->{oldpass}, 1);
$got_oldpass = 1 if $return_uid && $id == $return_uid;
}
slashDisplay('changePasswd', {
useredit => $user_edit,
admin_flag => $suadmin_flag,
title => $title,
session => $session_select,
clocation => $clocation_select,
admin_block => $admin_block,
got_oldpass => $got_oldpass
});
}
#################################################################
sub editUser {
my($hr) = @_;
my $id = $hr->{uid} || '';
my $note = $hr->{note} || '';
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $plugins = $slashdb->getDescriptions('plugins');
my $user_edit = {};
my($admin_block, $title);
my $admin_flag = ($user->{is_admin}) ? 1 : 0;
my $fieldkey;
if ($admin_flag && $form->{userfield}) {
$id ||= $form->{userfield};
if ($form->{userfield} =~ /^\d+$/) {
$user_edit = $slashdb->getUser($id);
$fieldkey = 'uid';
} else {
$user_edit = $slashdb->getUser($slashdb->getUserUID($id));
$fieldkey = 'nickname';
}
} else {
$user_edit = $id eq '' ? $user : $slashdb->getUser($id);
$fieldkey = 'uid';
$id = $user_edit->{uid};
}
return if isAnon($user_edit->{uid}) && ! $admin_flag;
$admin_block = getUserAdmin($id, $fieldkey, 1) if $admin_flag;
$user_edit->{homepage} ||= "http://";
# Remove domain tags, they'll be added back in, in saveUser.
for my $dat (@{$user_edit}{qw(sig bio)}) {
$dat = parseDomainTags($dat, 0, 1);
}
$title = getTitle('editUser_title', { user_edit => $user_edit});
my $editkey = "";
$editkey = editKey($user_edit->{uid}) if $fieldkey eq 'uid' && $plugins->{PubKey};
slashDisplay('editUser', {
useredit => $user_edit,
admin_flag => $admin_flag,
title => $title,
editkey => $editkey,
admin_block => $admin_block,
note => $note,
});
}
#################################################################
sub editHome {
my($hr) = @_;
my $id = $hr->{uid} || '';
my $note = $hr->{note} || '';
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my($formats, $title, $tzformat_select);
my $user_edit = {};
my $fieldkey;
my $admin_flag = ($user->{is_admin}) ? 1 : 0;
my $admin_block = '';
if ($admin_flag && $form->{userfield}) {
$id ||= $form->{userfield};
if ($form->{userfield} =~ /^\d+$/) {
$user_edit = $slashdb->getUser($id);
$fieldkey = 'uid';
} else {
$user_edit = $slashdb->getUser($slashdb->getUserUID($id));
$fieldkey = 'nickname';
}
} else {
$user_edit = $id eq '' ? $user : $slashdb->getUser($id);
$fieldkey = 'uid';
}
#use Data::Dumper; $Data::Dumper::Sortkeys = 1; print STDERR scalar(localtime) . " user_edit: " . Dumper($user_edit);
return if isAnon($user_edit->{uid}) && ! $admin_flag;
$admin_block = getUserAdmin($id, $fieldkey, 1) if $admin_flag;
$title = getTitle('editHome_title');
return if $user->{seclev} < 100 && isAnon($user_edit->{uid});
$formats = $slashdb->getDescriptions('dateformats');
$tzformat_select = createSelect('tzformat', $formats, $user_edit->{dfid}, 1);
my $lb_check = $user_edit->{lowbandwidth} ? $constants->{markup_checked_attribute} : '';
my $sd_check = $user_edit->{simpledesign} ? $constants->{markup_checked_attribute} : '';
my $i_check = $user_edit->{noicons} ? $constants->{markup_checked_attribute} : '';
my $w_check = $user_edit->{willing} ? $constants->{markup_checked_attribute} : '';
my $classic_check = $user_edit->{index_classic} ? $constants->{markup_checked_attribute} : '';
my $tilde_ed = tildeEd($user_edit);
slashDisplay('editHome', {
title => $title,
admin_block => $admin_block,
user_edit => $user_edit,
tzformat_select => $tzformat_select,
i_check => $i_check,
w_check => $w_check,
lb_check => $lb_check,
sd_check => $sd_check,
classic_check => $classic_check,
tilde_ed => $tilde_ed,
note => $note,
});
}
#################################################################
sub editComm {
my($hr) = @_;
my $id = $hr->{uid} || '';
my $note = $hr->{note} || '';
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $user_edit = {};
my($formats, $commentmodes_select, $commentsort_select, $title,
$uthreshold_select, $highlightthresh_select, $posttype_select,
$bytelimit_select);
my $admin_block = '';
my $fieldkey;
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $admin_flag = $user->{is_admin} ? 1 : 0;
if ($admin_flag && $form->{userfield}) {
$id ||= $form->{userfield};
if ($form->{userfield} =~ /^\d+$/) {
$user_edit = $slashdb->getUser($id);
$fieldkey = 'uid';
} else {
$user_edit = $slashdb->getUser($slashdb->getUserUID($id));
$fieldkey = 'nickname';
}
} else {
$user_edit = $id eq '' ? $user : $slashdb->getUser($id);
$fieldkey = 'uid';
}
my $hi = $constants->{comment_maxscore} - $constants->{comment_minscore};
my $lo = -$hi;
my @range = map { $_ > 0 ? "+$_" : $_ } ($lo .. $hi);
my @reasons = ( );
my %reason_select = ( );
if ($constants->{m1}) {
my $mod_reader = getObject("Slash::$constants->{m1_pluginname}", { db_type => 'reader' });
my $reasons = $mod_reader->getReasons();
for my $id (sort { $a <=> $b } keys %$reasons) {
push @reasons, $reasons->{$id}{name};
}
# Reason modifiers
for my $reason_name (@reasons) {
my $key = "reason_alter_$reason_name";
$reason_select{$reason_name} = createSelect(
$key, \@range,
$user_edit->{$key} || 0, 1, 1
);
}
}
# Zoo relation modifiers
my %people_select;
my @people = qw(friend foe anonymous fof eof freak fan);
for (@people) {
my $key = "people_bonus_$_";
$people_select{$_} = createSelect($key, \@range,
$user_edit->{$key} || 0, 1, 1
);
}
# New-user modifier
my $new_user_bonus_select = createSelect('new_user_bonus', \@range,
$user_edit->{new_user_bonus} || 0, 1, 1);
my $new_user_percent_select = createSelect('new_user_percent',
[( 1..15, 20, 25, 30, 35, 40, 45, 50, 55,
60, 65, 70, 75, 80, 85, 90, 95 )],
$user_edit->{new_user_percent} || 100, 1, 1);
# Karma modifier
my $karma_bonus = createSelect('karma_bonus', \@range,
$user_edit->{karma_bonus} || 0, 1, 1);
# Subscriber modifier
my $subscriber_bonus = createSelect('subscriber_bonus', \@range,
$user_edit->{subscriber_bonus} || 0, 1, 1);
# Length modifier
my $small_length_bonus_select = createSelect('clsmall_bonus', \@range,
$user_edit->{clsmall_bonus} || 0, 1, 1);
my $long_length_bonus_select = createSelect('clbig_bonus', \@range,
$user_edit->{clbig_bonus} || 0, 1, 1);
return if isAnon($user_edit->{uid}) && ! $admin_flag;
$admin_block = getUserAdmin($id, $fieldkey, 1) if $admin_flag;
$title = getTitle('editComm_title');
$formats = $slashdb->getDescriptions('commentmodes');
$commentmodes_select=createSelect('umode', $formats, $user_edit->{mode}, 1);
$formats = $slashdb->getDescriptions('sortcodes');
$commentsort_select = createSelect(
'commentsort', $formats, $user_edit->{commentsort}, 1
);
$formats = $slashdb->getDescriptions('threshcodes');
$uthreshold_select = createSelect(
'uthreshold', $formats, $user_edit->{threshold}, 1
);
$formats = $slashdb->getDescriptions('threshcodes');
$highlightthresh_select = createSelect(
'highlightthresh', $formats, $user_edit->{highlightthresh}, 1
);
$user_edit->{bytelimit} = $constants->{defaultbytelimit}
if $user_edit->{bytelimit} < 0 || $user_edit->{bytelimit} > 7;
my $bytelimit_desc = $user_edit->{is_subscriber} ? 'bytelimit' : 'bytelimit_sub';
$formats = $slashdb->getDescriptions($bytelimit_desc);
$bytelimit_select = createSelect(
'bytelimit', $formats, $user_edit->{bytelimit}, 1
);
my $h_check = $user_edit->{hardthresh} ? $constants->{markup_checked_attribute} : '';
my $r_check = $user_edit->{reparent} ? $constants->{markup_checked_attribute} : '';
my $n_check = $user_edit->{noscores} ? $constants->{markup_checked_attribute} : '';
my $s_check = $user_edit->{nosigs} ? $constants->{markup_checked_attribute} : '';
my $b_check = $user_edit->{nobonus} ? $constants->{markup_checked_attribute} : '';
my $sb_check = $user_edit->{nosubscriberbonus} ? $constants->{markup_checked_attribute} : '';
my $p_check = $user_edit->{postanon} ? $constants->{markup_checked_attribute} : '';
my $nospell_check = $user_edit->{no_spell} ? $constants->{markup_checked_attribute} : '';
my $s_mod_check = $user_edit->{mod_with_comm} ? $constants->{markup_checked_attribute} : '';
my $s_m2_check = $user_edit->{m2_with_mod} ? $constants->{markup_checked_attribute} : '';
my $s_m2c_check = $user_edit->{m2_with_comm_mod} ? $constants->{markup_checked_attribute} : '';
$formats = $slashdb->getDescriptions('postmodes');
$posttype_select = createSelect(
'posttype', $formats, $user_edit->{posttype}, 1
);
slashDisplay('editComm', {
title => $title,
admin_block => $admin_block,
user_edit => $user_edit,
h_check => $h_check,
r_check => $r_check,
n_check => $n_check,
s_check => $s_check,
b_check => $b_check,
sb_check => $sb_check,
p_check => $p_check,
s_mod_check => $s_mod_check,
s_m2_check => $s_m2_check,
s_m2c_check => $s_m2c_check,
nospell_check => $nospell_check,
commentmodes_select => $commentmodes_select,
commentsort_select => $commentsort_select,
highlightthresh_select => $highlightthresh_select,
uthreshold_select => $uthreshold_select,
posttype_select => $posttype_select,
reasons => \@reasons,
reason_select => \%reason_select,
people => \@people,
people_select => \%people_select,
new_user_percent_select => $new_user_percent_select,
new_user_bonus_select => $new_user_bonus_select,
note => $note,
karma_bonus => $karma_bonus,
subscriber_bonus => $subscriber_bonus,
small_length_bonus_select => $small_length_bonus_select,
long_length_bonus_select => $long_length_bonus_select,
bytelimit_select => $bytelimit_select,
});
}
#################################################################
sub saveUserAdmin {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my($user_edits_table, $user_edit) = ({}, {});
my $author_flag;
my $note = '';
my $srcid;
my $id;
my $user_editfield_flag;
my $banned = 0;
my $banref;
if ($form->{uid}) {
$user_editfield_flag = 'uid';
$id = $form->{uid};
$user_edit = $slashdb->getUser($id);
$srcid = $id;
} elsif ($form->{subnetid}) {
$user_editfield_flag = 'subnetid';
($id, $user_edit->{subnetid}) = ($form->{subnetid}, $form->{subnetid});
$user_edit->{nonuid} = 1;
$srcid = convert_srcid(subnetid => $id);
} elsif ($form->{ipid}) {
$user_editfield_flag = 'ipid';
($id, $user_edit->{ipid}) = ($form->{ipid}, $form->{ipid});
$user_edit->{nonuid} = 1;
$srcid = convert_srcid(ipid => $id);
} elsif ($form->{md5id}) {
$user_editfield_flag = 'md5id';
my $fieldname = $form->{fieldname} || 'md5id';
($id, $user_edit->{$fieldname})
= ($form->{md5id}, $form->{md5id});
warn "form field md5id specified, no srcid saving possible";
} elsif ($form->{srcid}) {
$user_editfield_flag = 'srcid';
my $fieldname = $form->{fieldname} || 'srcid';
($id, $user_edit->{$fieldname})
= ($form->{srcid}, $form->{srcid});
$srcid = $id;
} else {
# If we were not fed valid data, don't do anything.
return ;
}
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $all_al2types = $reader->getAL2Types;
my $al2_change = { };
# First, get a hash of what aclams (AL2's and ACLs) this user
# had when the previous admin page was loaded.
# XXXSRCID Right now acl_old is just calculated for debugging
# printing purposes, not actually used.
my @al2_old = ( );
@al2_old =
@{ $form->{al2_old_multiple} } if $form->{al2_old_multiple};
my %al2_old = ( map { ($_, 1) } @al2_old );
my @acl_old = ( );
@acl_old =
@{ $form->{acl_old_multiple} } if $form->{acl_old_multiple};
my %acl_old = ( map { ($_, 1) } @acl_old );
# Next, get the list of the new data submitted. Separate
# it out into AL2's which are legitimate. Anything left
# over is an ACL.
my @al2_new_formfields = ( );
@al2_new_formfields = @{ $form->{aclams_new_multiple} } if $form->{aclams_new_multiple};
my @al2_new_submitted = map { s/^aclam_//; $_ } @al2_new_formfields;
my @al2_new = grep { exists $all_al2types->{$_} } @al2_new_submitted;
my %al2_new = ( map { ($_, 1) } @al2_new );
my @acl_new = grep { !$al2_new{$_} } @al2_new_submitted;
my %acl_new = ( map { ($_, 1) } @acl_new );
# Find out what changed for AL2's.
for my $al2 (@al2_old, @al2_new) {
next if defined($al2_old{$al2}) && defined($al2_new{$al2})
&& $al2_old{$al2} == $al2_new{$al2};
$al2_change->{$al2} = $al2_new{$al2} ? 1 : 0;
}
#print STDERR "al2_change for '$srcid': " . Dumper($al2_change);
# If there's a comment, throw that in.
if ($form->{al2_new_comment}) {
$al2_change->{comment} = $form->{al2_new_comment};
}
$al2_change = undef if !keys %$al2_change;
# Find out what changed for ACL's.
my $acl_change = { };
for my $acl (@acl_old, @acl_new) {
next if $acl_old{$acl} == $acl_new{$acl};
$acl_change->{$acl} = $acl_new{$acl} ? 1 : 0;
}
$acl_change = undef if !keys %$acl_change;
if ($user->{is_admin} && $srcid) {
$slashdb->setAL2($srcid, $al2_change);
}
if ($user->{is_admin} && ($user_editfield_flag eq 'uid' ||
$user_editfield_flag eq 'nickname')) {
# This admin user cannot assign a seclev higher than he/she
# already has.
my $seclev = $form->{seclev};
$seclev = $user->{seclev} if $seclev > $user->{seclev};
$user_edits_table->{seclev} = $seclev;
$user_edits_table->{section} = $form->{section};
$user_edits_table->{author} = $form->{author} ? 1 : 0 ;
$user_edits_table->{defaultpoints} = $form->{defaultpoints};
$user_edits_table->{tokens} = $form->{tokens};
$user_edits_table->{tag_clout} = $form->{tag_clout};
$user_edits_table->{m2info} = $form->{m2info};
$user_edits_table->{acl} = $acl_change if $acl_change;
$user_edits_table->{shill_static_marquee} = $form->{shill_static_marquee} ? 1 : undef;
$user_edits_table->{u2_friends_bios} = $form->{u2_friends_bios} ? 1 : undef;
$user_edits_table->{shill_rss_url} = $form->{shill_rss_url} ? $form->{shill_rss_url} : undef;
my $author = $slashdb->getAuthor($id);
my $was_author = ($author && $author->{author}) ? 1 : 0;
$slashdb->setUser($id, $user_edits_table);
$note .= getMessage('saveuseradmin_saveduser', { field => $user_editfield_flag, id => $id });
if ($was_author xor $user_edits_table->{author}) {
# A frequently-asked question for new Slash admins is
# why their authors aren't showing up immediately.
# Give them some help here with an informative message.
$note .= getMessage('saveuseradmin_authorchg', {
basedir => $slashdb->getDescriptions("site_info")
->{base_install_directory},
virtuser => $slashdb->{virtual_user},
});
}
}
if (!$user_edit->{nonuid}) {
if ($form->{expired} && $form->{expired} eq 'on') {
# $slashdb->setExpired($user_edit->{uid});
} else {
# $slashdb->setUnexpired($user_edit->{uid});
}
}
my $data = { uid => $id };
$data->{note} = $note if defined $note;
showInfo($data);
}
#################################################################
sub savePasswd {
my($hr) = @_;
my $note = $hr->{noteref} || undef;
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $error_flag = 0;
my $user_edit = {};
my $uid;
my $user_edits_table = {};
if ($user->{is_admin}) {
$uid = $form->{uid} || $user->{uid};
} else {
$uid = ($user->{uid} == $form->{uid}) ? $form->{uid} : $user->{uid};
}
$user_edit = $slashdb->getUser($uid);
if (!$user_edit->{nickname}) {
$$note .= getError('cookie_err', { titlebar => 0 }, 0, 1)
if $note;
$error_flag++;
}
if ($form->{pass1} ne $form->{pass2}) {
$$note .= getError('saveuser_passnomatch_err', { titlebar => 0 }, 0, 1)
if $note;
$error_flag++;
}
if (!$form->{pass1} || length $form->{pass1} < 6) {
$$note .= getError('saveuser_passtooshort_err', { titlebar => 0 }, 0, 1)
if $note;
$error_flag++;
}
if (!$user->{is_admin}){
# not an admin -- check old password before changing passwd
my $return_uid = $slashdb->getUserAuthenticate($uid, $form->{oldpass}, 1);
if (!$return_uid || $return_uid != $uid) {
$$note .= getError('saveuser_badoldpass_err', { titlebar => 0 }, 0, 1)
if $note;
$error_flag++;
}
}
if (! $error_flag) {
$user_edits_table->{passwd} = $form->{pass1} if $form->{pass1};
$user_edits_table->{session_login} = $form->{session_login};
$user_edits_table->{cookie_location} = $form->{cookie_location};
# changed pass, so delete all logtokens
$slashdb->deleteLogToken($form->{uid}, 1);
if ($user->{admin_clearpass}
&& !$user->{state}{admin_clearpass_thisclick}) {
# User is an admin who sent their password in the clear
# some time ago; now that it's been changed, we'll forget
# about that incident, unless this click was sent in the
# clear as well.
$user_edits_table->{admin_clearpass} = '';
}
getOtherUserParams($user_edits_table);
$slashdb->setUser($uid, $user_edits_table) ;
$$note .= getMessage('saveuser_passchanged_msg',
{ nick => $user_edit->{nickname}, uid => $user_edit->{uid} },
0, 1) if $note;
# only set cookie if user is current user
if ($form->{uid} eq $user->{uid}) {
$user->{logtoken} = bakeUserCookie($uid, $slashdb->getLogToken($form->{uid}, 1));
setCookie('user', $user->{logtoken}, $user_edits_table->{session_login});
}
}
return $error_flag;
}
#################################################################
sub saveUser {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $gSkin = getCurrentSkin();
my $plugins = $slashdb->getDescriptions('plugins');
my $uid;
my $user_editfield_flag;
$uid = $user->{is_admin} && $form->{uid} ? $form->{uid} : $user->{uid};
my $user_edit = $slashdb->getUser($uid);
my($note, $formname);
$note .= getMessage('savenickname_msg', {
nickname => $user_edit->{nickname},
}, 1);
if (!$user_edit->{nickname}) {
$note .= getError('cookie_err', 0, 1);
}
# Check to ensure that if a user is changing his email address, that
# it doesn't already exist in the userbase.
if ($user_edit->{realemail} ne $form->{realemail}) {
if ($slashdb->existsEmail($form->{realemail})) {
$note .= getError('emailexists_err', 0, 1);
$form->{realemail} = $user_edit->{realemail}; # can't change!
}
}
my(%extr, $err_message, %limit);
$limit{sig} = 120; # schema is 200, give an extra buffer for domain tags
$limit{bio} = $constants->{users_bio_length} || 1024; # can be up to 2^16
for my $key (keys %limit) {
my $dat = chopEntity($form->{$key}, $limit{$key});
$dat = strip_html($dat);
$dat = balanceTags($dat, { deep_nesting => 2, length => $limit{$key} });
$dat = addDomainTags($dat) if $dat;
# If the sig becomes too long to fit (domain tagging causes
# string expansion and tag balancing can too), warn the user to
# use shorter domain names and don't save their change.
if ($key eq 'sig' && defined($dat) && length($dat) > 200) {
print getError('sig_too_long_err');
$extr{sig} = undef;
}
# really, comment filters should ignore short length IMO ... oh well.
if (length($dat) > 1 && ! filterOk('comments', 'postersubj', $dat, \$err_message)) {
print getError('filter message', {
err_message => $err_message,
item => $key,
});
$extr{$key} = undef;
} elsif (! compressOk('comments', 'postersubj', $dat)) {
print getError('compress filter', {
ratio => 'postersubj',
item => $key,
});
$extr{$key} = undef;
} else {
$extr{$key} = $dat;
}
}
# We should do some conformance checking on a user's pubkey,
# make sure it looks like one of the known types of public
# key. Until then, just make sure it doesn't have HTML.
$form->{pubkey} = $plugins->{'PubKey'} ? strip_nohtml($form->{pubkey}, 1) : '';
my $homepage = $form->{homepage};
$homepage = '' if $homepage eq 'http://';
$homepage = fudgeurl($homepage);
$homepage = URI->new_abs($homepage, $gSkin->{absolutedir})
->canonical
->as_string if $homepage ne '';
$homepage = substr($homepage, 0, 100) if $homepage ne '';
my $calendar_url = $form->{calendar_url};
if (length $calendar_url) {
# fudgeurl() doesn't like webcal; will remove later anyway
$calendar_url =~ s/^webcal/http/i;
$calendar_url = fudgeurl($calendar_url);
$calendar_url = URI->new_abs($calendar_url, $gSkin->{absolutedir})
->canonical
->as_string if $calendar_url ne '';
$calendar_url =~ s|^http://||i;
$calendar_url = substr($calendar_url, 0, 200) if $calendar_url ne '';
}
# for the users table
my $user_edits_table = {
homepage => $homepage,
realname => $form->{realname},
pubkey => $form->{pubkey},
copy => $form->{copy},
quote => $form->{quote},
calendar_url => $calendar_url,
yahoo => $form->{yahoo},
jabber => $form->{jabber},
aim => $form->{aim},
aimdisplay => $form->{aimdisplay},
icq => $form->{icq},
playing => $form->{playing},
mobile_text_address => $form->{mobile_text_address},
};
if ($constants->{wow}) {
my $wowdb = getObject("Slash::WoW");
if ($wowdb) {
$user_edits_table->{wow_main_name} = "\L\u$form->{wow_main_name}";
$user_edits_table->{wow_main_realm} = $form->{wow_main_realm};
my $charid = $wowdb->getCharidCreate($user_edits_table->{wow_main_realm},
$user_edits_table->{wow_main_name});
$wowdb->setChar($charid, { uid => $uid }, { if_unclaimed => 1 }) if $charid;
}
}
for (keys %extr) {
$user_edits_table->{$_} = $extr{$_} if defined $extr{$_};
}
# don't want undef, want to be empty string so they
# will overwrite the existing record
for (keys %$user_edits_table) {
$user_edits_table->{$_} = '' unless defined $user_edits_table->{$_};
}
if ($user_edit->{realemail} ne $form->{realemail}) {
$user_edits_table->{realemail} =
chopEntity($form->{realemail}, 50);
my $new_fakeemail = ''; # at emaildisplay 0, don't show any email address
if ($user->{emaildisplay}) {
$new_fakeemail = getArmoredEmail($uid, $user_edits_table->{realemail})
if $user->{emaildisplay} == 1;
$new_fakeemail = $user_edits_table->{realemail}
if $user->{emaildisplay} == 2;
}
$user_edits_table->{fakeemail} = $new_fakeemail;
$note .= getMessage('changeemail_msg', {
realemail => $user_edit->{realemail}
}, 1);
my $saveuser_emailtitle = getTitle('saveUser_email_title', {
nickname => $user_edit->{nickname},
realemail => $form->{realemail}
}, 1);
my $saveuser_email_msg = getMessage('saveuser_email_msg', {
nickname => $user_edit->{nickname},
realemail => $form->{realemail}
}, 1);
sendEmail($form->{realemail}, $saveuser_emailtitle, $saveuser_email_msg);
doEmail($uid, $saveuser_emailtitle, $saveuser_email_msg);
}
getOtherUserParams($user_edits_table);
$slashdb->setUser($uid, $user_edits_table);
editUser({ uid => $uid, note => $note });
}
#################################################################
sub saveComm {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $constants = getCurrentStatic();
my($uid, $user_fakeemail);
if ($user->{is_admin}) {
$uid = $form->{uid} || $user->{uid};
} else {
$uid = ($user->{uid} == $form->{uid}) ?
$form->{uid} : $user->{uid};
}
# Do the right thing with respect to the chosen email display mode
# and the options that can be displayed.
my $user_edit = $slashdb->getUser($uid);
my $new_fakeemail = ''; # at emaildisplay 0, don't show any email address
if ($form->{emaildisplay}) {
$new_fakeemail = getArmoredEmail($uid) if $form->{emaildisplay} == 1;
$new_fakeemail = $user_edit->{realemail} if $form->{emaildisplay} == 2;
}
my $name = $user->{seclev} && $form->{name} ?
$form->{name} : $user->{nickname};
my $note = getMessage('savenickname_msg',
{ nickname => $name });
print getError('cookie_err') if isAnon($uid) || !$name;
# Take care of the lists
# Enforce Ranges for variables that need it
$form->{commentlimit} = 0 if $form->{commentlimit} < 1;
my $cl_max = $constants->{comment_commentlimit} || 0;
$form->{commentlimit} = $cl_max if $cl_max > 0 && $form->{commentlimit} > $cl_max;
$form->{commentspill} = 0 if $form->{commentspill} < 1;
# For some of these values, namely the ones that we happen to
# know get stored in users_param, we change them to 'undef'
# if they are the default value. This deletes them from the
# users_param table, which has the same effect as storing the
# default except it's faster all around. If we ever change
# the schema to promote these fields from params into a
# proper users_* table, then this will no longer be correct.
# See prepareUser().
my $max = $constants->{comment_maxscore} - $constants->{comment_minscore};
my $min = -$max;
my $karma_bonus = ($form->{karma_bonus} !~ /^[\-+]?\d+$/) ? "+1" : $form->{karma_bonus};
my $subscriber_bonus = ($form->{subscriber_bonus} !~ /^[\-+]?\d+$/) ? "+1" : $form->{subscriber_bonus};
my $new_user_bonus = ($form->{new_user_bonus} !~ /^[\-+]?\d+$/) ? 0 : $form->{new_user_bonus};
my $new_user_percent = (($form->{new_user_percent} <= 100 && $form->{new_user_percent} >= 0)
? $form->{new_user_percent}
: 100);
my $clsmall_bonus = ($form->{clsmall_bonus} !~ /^[\-+]?\d+$/) ? 0 : $form->{clsmall_bonus};
my $clbig_bonus = ($form->{clbig_bonus} !~ /^[\-+]?\d+$/) ? 0 : $form->{clbig_bonus};
# plum
$form->{d2_comment_q} = (isSubscriber($user_edit) || $user_edit->{seclev} >= 100)
? $form->{d2_comment_q}
: ($form->{d2_comment_q} eq '0')
? 1
: $form->{d2_comment_q};
my $user_edits_table = {
# MC: More D2 neutring
#discussion2 => $form->{discussion2} || undef,
#d2_comment_q => $form->{d2_comment_q} || undef,
#d2_comment_order => $form->{d2_comment_order} || undef,
clsmall => $form->{clsmall},
clsmall_bonus => ($clsmall_bonus || undef),
clbig => $form->{clbig},
clbig_bonus => ($clbig_bonus || undef),
commentlimit => $form->{commentlimit},
bytelimit => $form->{bytelimit},
commentsort => $form->{commentsort},
commentspill => $form->{commentspill},
domaintags => ($form->{domaintags} != 2 ? $form->{domaintags} : undef),
emaildisplay => $form->{emaildisplay} || undef,
fakeemail => $new_fakeemail,
highlightthresh => $form->{highlightthresh},
mode => $form->{umode},
posttype => $form->{posttype},
threshold => $form->{uthreshold},
nosigs => ($form->{nosigs} ? 1 : 0),
reparent => ($form->{reparent} ? 1 : 0),
noscores => ($form->{noscores} ? 1 : 0),
hardthresh => ($form->{hardthresh} ? 1 : 0),
no_spell => ($form->{no_spell} ? 1 : undef),
nobonus => ($form->{nobonus} ? 1 : undef),
nosubscriberbonus => ($form->{nosubscriberbonus} ? 1 : undef),
postanon => ($form->{postanon} ? 1 : undef),
new_user_percent => ($new_user_percent && $new_user_percent != 100
? $new_user_percent : undef),
new_user_bonus => ($new_user_bonus || undef),
karma_bonus => ($karma_bonus ne '+1' ? $karma_bonus : undef),
subscriber_bonus => ($subscriber_bonus || undef),
textarea_rows => ($form->{textarea_rows} != $constants->{textarea_rows}
? $form->{textarea_rows} : undef),
textarea_cols => ($form->{textarea_cols} != $constants->{textarea_cols}
? $form->{textarea_cols} : undef),
user_comment_sort_type => ($form->{user_comment_sort_type} != 2
? $form->{user_comment_sort_type} : undef ),
mod_with_comm => ($form->{mod_with_comm} ? 1 : undef),
m2_with_mod => ($form->{m2_with_mod} ? 1 : undef),
m2_with_comm_mod => ($form->{m2_with_mod_on_comm} ? 1 : undef),
};
# set our default values for the items where an empty-string won't do
my $defaults = {
posttype => 2,
highlightthresh => 4,
reparent => 1,
commentlimit => 100,
commentspill => 50,
mode => 'thread'
};
my $mod_reader = getObject("Slash::$constants->{m1_pluginname}", { db_type => 'reader' });
my @reasons = ( );
my $reasons = $mod_reader->getReasons();
for my $id (sort { $a <=> $b } keys %$reasons) {
push @reasons, $reasons->{$id}{name};
}
for my $reason_name (@reasons) {
my $key = "reason_alter_$reason_name";
my $answer = $form->{$key} || 0;
$answer = 0 if !$answer || $answer !~ /^[\-+]?\d+$/;
$user_edits_table->{$key} = ($answer == 0) ? '' : $answer;
}
for (qw| friend foe anonymous fof eof freak fan |) {
my $answer = $form->{"people_bonus_$_"};
$answer = 0 if $answer !~ /^[\-+]?\d+$/;
$user_edits_table->{"people_bonus_$_"} = ($answer == 0) ? '' : $answer;
}
getOtherUserParams($user_edits_table);
setToDefaults($user_edits_table, {}, $defaults) if $form->{restore_defaults};
$slashdb->setUser($uid, $user_edits_table);
editComm({ uid => $uid, note => $note });
}
#################################################################
sub saveHome {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $constants = getCurrentStatic();
my($uid, $error);
if ($user->{is_admin}) {
$uid = $form->{uid} || $user->{uid} ;
} else {
$uid = ($user->{uid} == $form->{uid}) ?
$form->{uid} : $user->{uid};
}
my $edit_user = $slashdb->getUser($uid);
my $name = $user->{seclev} && $form->{name} ?
$form->{name} : $user->{nickname};
$name = substr($name, 0, 20);
my $note = getMessage('savenickname_msg',
{ nickname => $name });
if (isAnon($uid) || !$name) {
my $cookiemsg = getError('cookie_err');
print $cookiemsg;
}
# Using the existing list of slashboxes and the set of
# what's checked and not, build up the new list.
# (New arrivals go at the end.)
my $slashboxes = $edit_user->{slashboxes};
# Only go through all this if the user clicked save,
# not "Restore Slashbox Defaults"!
my($boxes, $skinBoxes) = $slashdb->getPortalsCommon();
my $default_slashboxes_textlist = join ",",
@{$skinBoxes->{$constants->{mainpage_skid}}};
if (!$form->{restore_slashbox_defaults}) {
$slashboxes = $default_slashboxes_textlist if !$slashboxes;
my @slashboxes = split /,/, $slashboxes;
my %slashboxes = ( );
for my $i (0..$#slashboxes) {
$slashboxes{$slashboxes[$i]} = $i;
}
# Add new boxes in.
for my $key (sort grep /^showbox_/, keys %$form) {
my($bid) = $key =~ /^showbox_(\w+)$/;
next if length($bid) < 1 || length($bid) > 30 || $bid !~ /^\w+$/;
if (! exists $slashboxes{$bid}) {
$slashboxes{$bid} = 999; # put it at the end
}
}
# Remove any boxes that weren't checked.
for my $bid (@slashboxes) {
delete $slashboxes{$bid} unless $form->{"showbox_$bid"};
}
for my $key (sort grep /^dynamic_/, keys %$form) {
my($bid) = $key =~ /^dynamic_(.+)$/;
next if length($bid) < 1;
if (! exists $slashboxes{$bid}) {
$slashboxes{$bid} = 999;
}
}
@slashboxes = sort {
$slashboxes{$a} <=> $slashboxes{$b}
||
$a cmp $b
} keys %slashboxes;
# This probably should be a var (and appear in tilded_customize_msg)
$#slashboxes = 19 if $#slashboxes > 19;
$slashboxes = join ",", @slashboxes;
}
# If we're right back to the default, that means the
# empty string.
if ($slashboxes eq $default_slashboxes_textlist) {
$slashboxes = "";
}
# Set the story_never and story_always fields.
my $author_hr = $slashdb->getDescriptions('authors');
my $tree = $slashdb->getTopicTree();
my(@story_never_topic, @story_never_author, @story_never_nexus);
my(@story_always_topic, @story_always_author);
my(@story_always_nexus, @story_full_brief_nexus, @story_brief_always_nexus, @story_full_best_nexus, @story_brief_best_nexus);
my($story_topic_all, $story_author_all, $story_nexus_all) = (0, 0, 0);
# Topics are either present (value=2) or absent (value=0). If absent,
# push them onto the never list. Otherwise, do nothing. (There's no
# way to have an "always" topic, at the moment.) If the hidden
# field topictids_present is false, then there are no topic tids,
# skip this.
if ($form->{topictids_present}) {
for my $tid (
sort { $a <=> $b }
grep { !$tree->{$_}{nexus} }
keys %$tree
) {
my $key = "topictid$tid";
$story_topic_all++;
if (!$form->{$key}) { push @story_never_topic, $tid }
}
}
# Authors are either present (value=2) or absent (value=0). If
# absent, push them onto the never list. Otherwise, do nothing.
# (There's no way to have an "always" author, at the moment.)
for my $aid (sort { $a <=> $b } keys %$author_hr) {
my $key = "aid$aid";
$story_author_all++;
if (!$form->{$key}) { push @story_never_author, $aid }
}
# Nexuses can have value 0, 1, 2, 3, 4, 5.
# 0 means the never list,
# 1 means brief view of mainpage articles only
# 2 means full view of mainpage articles only
# 3 means brief view of all content
# 4 means full view of mainpage content, brief view of sectional
# 5 means full view of all content
for my $tid (
sort { $a <=> $b }
map { /^nexustid(\d+)$/; $1 }
grep { /^nexustid\d+$/ }
keys %$form
) {
my $key = "nexustid$tid";
next unless $tid && $tree->{$tid} && $tree->{$tid}{nexus};
$story_nexus_all++;
if (!$form->{$key}) { push @story_never_nexus, $tid }
elsif ($form->{$key} == 5 ) { push @story_always_nexus, $tid }
elsif ($form->{$key} == 4 ) { push @story_full_brief_nexus, $tid }
elsif ($form->{$key} == 3 ) { push @story_brief_always_nexus, $tid }
elsif ($form->{$key} == 2 ) { push @story_full_best_nexus, $tid }
elsif ($form->{$key} == 1 ) { push @story_brief_best_nexus, $tid }
}
#use Data::Dumper; $Data::Dumper::Sortkeys = 1; print STDERR scalar(localtime) . " s_n_t '@story_never_topic' s_n_a '@story_never_author' s_n_n '@story_never_nexus' s_a_n '@story_always_nexus' form: " . Dumper($form);
# Sanity check.
$#story_never_topic = 299 if $#story_never_topic > 299;
$#story_never_author = 299 if $#story_never_author > 299;
$#story_never_nexus = 299 if $#story_never_nexus > 299;
$#story_always_topic = 299 if $#story_always_topic > 299;
$#story_always_author = 299 if $#story_always_author > 299;
$#story_always_nexus = 299 if $#story_always_nexus > 299;
$#story_full_brief_nexus = 299 if $#story_full_brief_nexus > 299;
$#story_brief_always_nexus = 299 if $#story_brief_always_nexus > 299;
$#story_brief_best_nexus = 299 if $#story_brief_best_nexus > 299;
$#story_full_best_nexus = 299 if $#story_full_best_nexus > 299;
my $story_never_topic = join ",", @story_never_topic;
$story_never_topic = ($constants->{subscribe} && $user->{is_subscriber})
? checkList($story_never_topic, 1024)
: checkList($story_never_topic);
my $story_never_author = checkList(join ",", @story_never_author);
my $story_never_nexus = checkList(join ",", @story_never_nexus);
my $story_always_topic = checkList(join ",", @story_always_topic);
$story_always_topic = ($constants->{subscribe} && $user->{is_subscriber})
? checkList($story_always_topic, 1024)
: checkList($story_always_topic);
my $story_always_author = checkList(join ",", @story_always_author);
my $story_always_nexus = checkList(join ",", @story_always_nexus);
my $story_full_brief_nexus = checkList(join ",", @story_full_brief_nexus);
my $story_brief_always_nexus = checkList(join ",", @story_brief_always_nexus);
my $story_brief_best_nexus = checkList(join ",", @story_brief_best_nexus);
my $story_full_best_nexus = checkList(join ",", @story_full_best_nexus);
my $user_edits_table = {
story_never_topic => $story_never_topic,
story_never_author => $story_never_author,
story_never_nexus => $story_never_nexus,
story_always_topic => $story_always_topic,
story_always_author => $story_always_author,
story_always_nexus => $story_always_nexus,
story_brief_always_nexus => $story_brief_always_nexus,
story_full_brief_nexus => $story_full_brief_nexus,
story_full_best_nexus => $story_full_best_nexus,
story_brief_best_nexus => $story_brief_best_nexus,
slashboxes => checkList($slashboxes, 1024),
maxstories => 30, # XXXSKIN fix this later
noboxes => ($form->{useslashboxes} ? 0 : 1),
lowbandwidth => ($form->{lowbandwidth} ? 1 : 0),
simpledesign => ($form->{simpledesign} ? 1 : 0),
noicons => ($form->{noicons} ? 1 : 0),
willing => ($form->{willing} ? 1 : 0),
index_classic => ($form->{index_classic} ? 1 : undef),
};
if (defined $form->{tzcode} && defined $form->{tzformat}) {
$user_edits_table->{tzcode} = $form->{tzcode};
$user_edits_table->{dfid} = $form->{tzformat};
$user_edits_table->{dst} = $form->{dst};
}
# Force the User Space area to contain only known-good HTML tags.
# Unfortunately the cookie login model makes it just too risky
# to allow scripts in here; CSS's steal passwords. There are
# no known vulnerabilities at this time, but a combination of the
# social engineering taking place (inviting users to put Javascript
# from websites in here, and making available script URLs for that
# purpose), plus the fact that this could be used to amplify the
# seriousness of any future vulnerabilities, means it's way past
# time to shut this feature down. - Jamie 2002/03/06
# it's a VARCHAR ...
my $mylinks_limit = 255;
$user_edits_table->{mylinks} = balanceTags(strip_html(
chopEntity($form->{mylinks} || '', $mylinks_limit)
), { deep_nesting => 2, length => $mylinks_limit });
$user_edits_table->{mylinks} = '' unless defined $user_edits_table->{mylinks};
$error = 1;
# must select at least 1/4 of nexuses, topics, authors
if ( scalar(@story_never_author) > ($story_author_all * 3/4) ) {
$note = getError('editHome_too_many_disabled');
} elsif ( scalar(@story_never_nexus) > ($story_nexus_all * 3/4) ) {
$note = getError('editHome_too_many_disabled');
} elsif ( scalar(@story_never_topic) > ($story_topic_all * 3/4) ) {
$note = getError('editHome_too_many_disabled');
} else {
$error = 0;
}
unless ($error) {
# If a user is unwilling to moderate, we should cancel all points, lest
# they be preserved when they shouldn't be.
if (!isAnon($uid) && !$form->{willing}) {
$slashdb->setUser($uid, { points => 0 });
}
getOtherUserParams($user_edits_table);
if ($form->{restore_defaults}) {
setToDefaults($user_edits_table, {}, {
maxstories => 30,
tzcode => "EST",
# XXX shouldn't this reset ALL the defaults,
# not just these two?
});
}
if ($form->{restore_slashbox_defaults}) {
setToDefaults($user_edits_table, {
'story_never_topic' => 1,
'story_never_author' => 1,
'story_never_nexus' => 1,
'story_always_topic' => 1,
'story_always_author' => 1,
'story_always_nexus' => 1,
'story_full_brief_nexus' => 1,
'story_brief_always_nexus' => 1,
'story_full_best_nexus' => 1,
'story_brief_best_nexus' => 1,
'maxstories' => 1,
'noboxes' => 1,
'light' => 1,
'noicons' => 1,
'willing' => 1
}, { slashboxes => "" });
}
#print scalar(localtime) . " uet: " . Dumper($user_edits_table);
$slashdb->setUser($uid, $user_edits_table);
}
editHome({ uid => $uid, note => $note });
}
#################################################################
# A generic way for a site to allow users to edit data about themselves.
# Most useful when your plugin or theme wants to let the user change
# minor settings but you don't want to write a whole new version
# of users.pl to provide a user interface. The user can save any
# param of the format "opt_foo", as long as "foo" shows up in
# getMiscUserOpts which lists all the misc opts that this user can edit.
# This is *not* protected by formkeys (yet), so assume attackers can make
# users click and accidentally edit their own settings: no really important
# data should be stored in this way.
sub editMiscOpts {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $constants = getCurrentStatic();
my $note = $hr->{note} || "";
return if $user->{is_anon}; # shouldn't be, but can't hurt to check
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $edit_user = $slashdb->getUser($user->{uid});
my $title = getTitle('editMiscOpts_title');
my $opts = $slashdb->getMiscUserOpts();
for my $opt (@$opts) {
my $opt_name = "opt_" . $opt->{name};
$opt->{checked} = $edit_user->{$opt_name} ? 1 : 0;
}
slashDisplay('editMiscOpts', {
# useredit => $user_edit,
title => $title,
opts => $opts,
note => $note,
});
}
#################################################################
#
sub saveMiscOpts {
my($hr) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $constants = getCurrentStatic();
return if $user->{is_anon}; # shouldn't be, but can't hurt to check
my $edit_user = $slashdb->getUser($user->{uid});
my %opts_ok_hash = ( );
my $opts = $slashdb->getMiscUserOpts();
for my $opt (@$opts) {
$opts_ok_hash{"opt_$opt->{name}"} = 1;
}
my $update = { };
for my $opt (grep /^opt_/, keys %$form) {
next unless $opts_ok_hash{$opt};
$update->{$opt} = $form->{$opt} ? 1 : 0;
}
# Make the changes.
$slashdb->setUser($edit_user->{uid}, $update);
# Inform the user the change was made. Since we don't
# require formkeys, we always want to print a message to
# make sure the user sees what s/he did. This is done
# by passing in a note which ends up passed to the
# editMiscOpts template, which displays it.
editMiscOpts({ note => getMessage('savemiscopts_msg') });
}
#################################################################
sub listReadOnly {
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $readonlylist = $reader->getAL2List('nopost');
slashDisplay('listReadOnly', {
readonlylist => $readonlylist,
});
}
#################################################################
sub listBanned {
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $bannedlist = $reader->getAL2List('ban');
slashDisplay('listBanned', {
bannedlist => $bannedlist,
});
}
#################################################################
sub topAbusers {
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $topabusers = $reader->getTopAbusers();
slashDisplay('topAbusers', {
topabusers => $topabusers,
});
}
#################################################################
sub listAbuses {
my $user = getCurrentUser();
my $form = getCurrentForm();
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $constants = getCurrentStatic();
my $abuses = $reader->getAbuses($form->{key}, $form->{abuseid});
slashDisplay('listAbuses', {
abuseid => $form->{abuseid},
abuses => $abuses,
});
}
#################################################################
sub forceAccountVerify {
my $user = getCurrentUser();
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $uid = $form->{uid};
my $useredit = $slashdb->getUser($uid);
if ($useredit->{uid}) {
my $newpasswd = $slashdb->resetUserAccount($uid);
$slashdb->deleteLogToken($uid, 1);
my $emailtitle = getTitle('reset_acct_email_title', {
nickname => $useredit->{nickname}
}, 1);
my $msg = getMessage('reset_acct_msg', {
newpasswd => $newpasswd,
tempnick => $useredit->{nickname},
}, 1);
$slashdb->setUser($useredit->{uid}, {
waiting_for_account_verify => 1,
account_verify_request_time => $slashdb->getTime()
});
doEmail($useredit->{uid}, $emailtitle, $msg) if $useredit->{uid};
}
print getMessage("reset_acct_complete", { useredit => $useredit }, 1);
}
#################################################################
sub displayForm {
my($hr) = @_;
my $user = getCurrentUser();
my $form = getCurrentForm();
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $suadmin_flag = $user->{seclev} >= 10000 ? 1 : 0;
print createMenu("users", {
style => 'tabbed',
justify => 'right',
color => 'colored',
tab_selected => $hr->{tab_selected_1} || "",
});
my $op = $hr->{op} || $form->{op} || 'displayform';
my $ops = {
displayform => 'loginForm',
edithome => 'loginForm',
editcomm => 'loginForm',
edituser => 'loginForm',
# mailpasswdform => 'sendPasswdForm',
# newuserform => 'newUserForm',
userclose => 'loginForm',
userlogin => 'loginForm',
editmiscopts => 'loginForm',
savemiscopts => 'loginForm',
default => 'loginForm'
};
$op = 'default' if !defined($ops->{$op});
my($title, $title2, $msg1, $msg2) = ('', '', '', '');
if ($op eq 'userclose') {
$title = getMessage('userclose');
} elsif ($op eq 'displayForm') {
$title = $form->{unickname}
? getTitle('displayForm_err_title')
: getTitle('displayForm_title');
} elsif ($op eq 'mailpasswdform') {
$title = getTitle('mailPasswdForm_title');
} elsif ($op eq 'newuserform') {
$title = getTitle('newUserForm_title');
} else {
$title = getTitle('displayForm_title');
}
$form->{unickname} ||= $form->{newusernick};
if ($form->{newusernick}) {
$title2 = getTitle('displayForm_dup_title');
} else {
$title2 = getTitle('displayForm_new_title');
}
$msg1 = getMessage('dispform_new_msg_1');
if (! $form->{newusernick} && $op eq 'newuserform') {
$msg2 = getMessage('dispform_new_msg_2');
} elsif ($op eq 'displayform' || $op eq 'userlogin') {
$msg2 = getMessage('newuserform_msg');
}
slashDisplay($ops->{$op}, {
newnick => nickFix($form->{newusernick}),
suadmin_flag => $suadmin_flag,
title => $title,
title2 => $title2,
logged_in => $user->{is_anon} ? 0 : 1,
msg1 => $msg1,
msg2 => $msg2
});
}
#################################################################
# this groups all the messages together in
# one template, called "messages;users;default"
sub getMessage {
my($value, $hashref, $nocomm) = @_;
$hashref ||= {};
$hashref->{value} = $value;
return slashDisplay('messages', $hashref,
{ Return => 1, Nocomm => $nocomm });
}
#################################################################
# this groups all the errors together in
# one template, called "errors;users;default"
sub getError {
my($value, $hashref, $nocomm) = @_;
$hashref ||= {};
$hashref->{value} = $value;
return slashDisplay('errors', $hashref,
{ Return => 1, Nocomm => $nocomm });
}
#################################################################
# this groups all the titles together in
# one template, called "users-titles"
sub getTitle {
my($value, $hashref, $nocomm) = @_;
$hashref ||= {};
$hashref->{value} = $value;
return slashDisplay('titles', $hashref,
{ Return => 1, Nocomm => $nocomm });
}
#################################################################
# getUserAdmin - returns a block of HTML text that provides
# information and editing capabilities for admin users.
# Most of this data is already in the getUserAdmin template,
# but really, we should try to get more of this logic into
# that template.
sub getUserAdmin {
my($id, $field, $seclev_field) = @_;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $logdb = getObject('Slash::DB', { db_type => 'log_slave' });
my $user = getCurrentUser();
my $form = getCurrentForm();
my $constants = getCurrentStatic();
my $slashdb = getCurrentDB();
$id ||= $user->{uid};
my($expired, $uidstruct, $readonly);
my($user_edit, $user_editfield, $ipstruct, $ipstruct_order, $authors, $author_flag, $topabusers, $thresh_select,$section_select);
my $srcid;
my $proxy_check = {};
my @accesshits;
my $user_editinfo_flag = (!$form->{op} || $form->{op} eq 'userinfo'
|| $form->{userinfo} || $form->{saveuseradmin}
) ? 1 : 0;
my $authoredit_flag = ($user->{seclev} >= 10000) ? 1 : 0;
my $sectionref = $reader->getDescriptions('skins');
$sectionref->{''} = getData('all_sections');
$field ||= 'uid';
if ($field eq 'uid') {
$user_edit = $slashdb->getUser($id);
$user_editfield = $user_edit->{uid};
$srcid = convert_srcid( uid => $id );
#$expired = $slashdb->checkExpired($user_edit->{uid}) ? $constants->{markup_checked_attribute} : '';
$ipstruct = $slashdb->getNetIDStruct($user_edit->{uid});
@accesshits = $logdb->countAccessLogHitsInLastX($field, $user_edit->{uid}) if defined($logdb);
$section_select = createSelect('section', $sectionref, $user_edit->{section}, 1);
} elsif ($field eq 'nickname') {
$user_edit = $slashdb->getUser($slashdb->getUserUID($id));
$user_editfield = $user_edit->{nickname};
#$expired = $slashdb->checkExpired($user_edit->{uid}) ? $constants->{markup_checked_attribute} : '';
$ipstruct = $slashdb->getNetIDStruct($user_edit->{uid});
@accesshits = $logdb->countAccessLogHitsInLastX('uid', $user_edit->{uid}) if defined($logdb);
$section_select = createSelect('section', $sectionref, $user_edit->{section}, 1);
} elsif ($field eq 'md5id') {
$user_edit->{nonuid} = 1;
$user_edit->{md5id} = $id;
if ($form->{fieldname} && $form->{fieldname} =~ /^(ipid|subnetid)$/) {
$uidstruct = $slashdb->getUIDStruct($form->{fieldname}, $user_edit->{md5id});
@accesshits = $logdb->countAccessLogHitsInLastX($form->{fieldname}, $user_edit->{md5id}) if defined($logdb);
} else {
$uidstruct = $slashdb->getUIDStruct('md5id', $user_edit->{md5id});
@accesshits = $logdb->countAccessLogHitsInLastX($field, $user_edit->{md5id}) if defined($logdb);
}
} elsif ($field eq 'ipid') {
$user_edit->{nonuid} = 1;
$user_edit->{ipid} = $id;
$srcid = convert_srcid( ipid => $id );
$user_editfield = $id;
$uidstruct = $slashdb->getUIDStruct('ipid', $user_edit->{ipid});
@accesshits = $logdb->countAccessLogHitsInLastX('host_addr', $user_edit->{ipid}) if defined($logdb);
if ($form->{userfield} =~/^\d+\.\d+\.\d+\.(\d+)$/) {
if ($1 ne "0"){
$proxy_check->{available} = 1;
$proxy_check->{results} = $slashdb->checkForOpenProxy($form->{userfield}) if $form->{check_proxy};
}
}
} elsif ($field eq 'subnetid') {
$user_edit->{nonuid} = 1;
$srcid = convert_srcid( ipid => $id );
if ($id =~ /^(\d+\.\d+\.\d+)(?:\.\d)?/) {
$id = $1 . ".0";
$user_edit->{subnetid} = $id;
} else {
$user_edit->{subnetid} = $id;
}
$user_editfield = $id;
$uidstruct = $slashdb->getUIDStruct('subnetid', $user_edit->{subnetid});
@accesshits = $logdb->countAccessLogHitsInLastX($field, $user_edit->{subnetid}) if defined($logdb);
} elsif ($field eq "srcid") {
$user_edit->{nonuid} = 1;
$user_edit->{srcid} = $id;
$srcid = $id;
} else {
$user_edit = $id ? $slashdb->getUser($id) : $user;
$user_editfield = $user_edit->{uid};
$ipstruct = $slashdb->getNetIDStruct($user_edit->{uid});
@accesshits = $logdb->countAccessLogHitsInLastX('uid', $user_edit->{uid}) if defined($logdb);
}
##########
# Put together the array and hashref that the template will need
# to construct the list for display to the admin.
# Note that currently a srcid which is not a uid (i.e. which
# represents an IP address or masked IP network) cannot have
# any ACLs assigned to it. This may change in the future.
# The term "aclam" is used because it has a field set for both
# every ACL and every access modifier (i.e. AL2 bit) that is set
# for this user or srcid.
# For now, ACLs will be listed for IPs as well.
# First get the list of ACLs that can be used.
my $all_acls_ar = $reader->getAllACLNames();
my $all_acls_hr = { map { ( $_, 1 ) } @$all_acls_ar };
# Add in any ACLs selected for this user (just in case
# getAllACLNames is cached and stale).
for my $acl (keys %{$user_edit->{acl}}) {
$all_acls_hr->{$acl} = 1;
}
# Start creating the $all_aclam_hr data, in which the keys are
# the HTML selection names that all begin with aclam_ and the
# the values are their names/descriptions shown to the admin.
# First put all the ACLs into the hash, if we're editing a user.
my $all_aclam_hr = { };
if (!$user_edit->{nonuid}) {
$all_aclam_hr = { map { ( "aclam_$_", "ACL: $_" ) } keys %$all_acls_hr };
}
# Next put in all the al2 types.
my $all_al2types = $reader->getAL2Types;
for my $key (keys %$all_al2types) {
next if $key eq 'comment'; # skip the 'comment' type
$all_aclam_hr->{"aclam_$key"} = $all_al2types->{$key}{title};
}
# Finally, sort the keys of the hash into the order that we
# want them displayed to the admin (ACLs first).
my $all_acls_longkeys_hr = { map { ( "aclam_$_", 1 ) } keys %$all_acls_hr };
my $all_aclam_ar = [
sort {
(exists($all_acls_longkeys_hr->{$a}) ? -1 : 1) <=> (exists($all_acls_longkeys_hr->{$b}) ? -1 : 1)
||
$all_aclam_hr->{$a} cmp $all_aclam_hr->{$b}
} keys %$all_aclam_hr
];
# Now put together the hashref that identifies which of those
# items are selected for this user.
my $user_aclam_hr = { };
for my $acl (keys %{ $user_edit->{acl} }) {
$user_aclam_hr->{"aclam_$acl"} = 1;
}
my $al2_tid_comment = $all_al2types->{comment}{al2tid} || 0;
my $al2_log_ar = [ ];
my $al2_hr = { };
# XXXSRCID Once we get rid of the silly 'md5id' field and all the
# other bizarre backward-compatibility code paths early in this
# function, this won't be necessary, but until then we need this
# sanity check...
if ($srcid) {
# getAL2 works with either a srcids hashref or a single srcid
$al2_hr = $slashdb->getAL2($srcid);
for my $al2 (keys %{ $al2_hr }) {
$user_aclam_hr->{"aclam_$al2"} = 1;
}
$al2_log_ar = $slashdb->getAL2Log($srcid);
}
# Generate al2_nick_hr, which will be populated with keys of all
# the (presumably) admin uids who have logged rows for this al2,
# and values of their nicks.
my $al2_nick_hr = { };
for my $al2_log (@$al2_log_ar) {
my $uid = $al2_log->{adminuid};
next if !$uid; # odd error, might want to flag this
$al2_nick_hr->{$uid} ||= $slashdb->getUser($uid, 'nickname');
}
##########
$user_edit->{author} = ($user_edit->{author} && $user_edit->{author} == 1)
? $constants->{markup_checked_attribute} : '';
if (! $user->{nonuid}) {
my $threshcodes = $reader->getDescriptions('threshcode_values','',1);
$thresh_select = createSelect('defaultpoints', $threshcodes, $user_edit->{defaultpoints}, 1);
}
if (!ref $ipstruct) {
undef $ipstruct;
} else {
@$ipstruct_order = sort { $ipstruct->{$b}{dmin} cmp $ipstruct->{$a}{dmin} } keys %$ipstruct;
}
my $m2total = ($user_edit->{m2fair} || 0) + ($user_edit->{m2unfair} || 0);
if ($m2total) {
$user_edit->{m2unfairpercent} = sprintf("%.2f",
$user_edit->{m2unfair}*100/$m2total);
}
my $mod_total = ($user_edit->{totalmods} || 0) + ($user_edit->{stirred} || 0);
if ($mod_total) {
$user_edit->{stirredpercent} = sprintf("%.2f",
$user_edit->{stirred}*100/$mod_total);
}
if ($constants->{subscribe} and my $subscribe = getObject('Slash::Subscribe')) {
$user_edit->{subscribe_payments} =
$subscribe->getSubscriptionsForUser($user_edit->{uid});
$user_edit->{subscribe_purchases} =
$subscribe->getSubscriptionsPurchasedByUser($user_edit->{uid},{ only_types => [ "grant", "gift" ] });
}
my $ipid = $user_edit->{ipid};
my $subnetid = $user_edit->{subnetid};
my $post_restrictions = {};
my ($subnet_karma, $ipid_karma);
if ($ipid && !$subnetid) {
$ipid = md5_hex($ipid) if length($ipid) != 32;
$proxy_check->{ipid} = $ipid;
$proxy_check->{currently} = $slashdb->getKnownOpenProxy($ipid, "ipid");
# This next call is very slow.
$subnetid = $reader->getSubnetFromIPIDBasedOnComments($ipid);
}
if ($subnetid) {
$subnetid = md5_hex($subnetid) if length($subnetid) != 32;
# These next three calls can be very slow. In fact, getNetIDKarma
# is actually called twice on the same subnetid; if we can cache
# that data somehow that wouldn't be a bad idea.
$post_restrictions = $reader->getNetIDPostingRestrictions("subnetid", $subnetid);
$subnet_karma = $reader->getNetIDKarma("subnetid", $subnetid);
$ipid_karma = $reader->getNetIDKarma("ipid", $ipid) if $ipid;
}
my $clout_types_ar = [ sort grep /\D/, keys %{$slashdb->getCloutTypes} ];
return slashDisplay('getUserAdmin', {
field => $field,
useredit => $user_edit,
srcid => $srcid,
all_aclam_ar => $all_aclam_ar,
all_aclam_hr => $all_aclam_hr,
user_aclam_hr => $user_aclam_hr,
al2_old => $al2_hr,
al2_log => $al2_log_ar,
al2_tid_comment => $al2_tid_comment,
al2_nick => $al2_nick_hr,
userinfo_flag => $user_editinfo_flag,
userfield => $user_editfield,
ipstruct => $ipstruct,
ipstruct_order => $ipstruct_order,
uidstruct => $uidstruct,
accesshits => \@accesshits,
seclev_field => $seclev_field,
expired => $expired,
topabusers => $topabusers,
readonly => $readonly,
thresh_select => $thresh_select,
authoredit_flag => $authoredit_flag,
section_select => $section_select,
all_acls => $all_acls_hr,
proxy_check => $proxy_check,
subnet_karma => $subnet_karma,
ipid_karma => $ipid_karma,
post_restrictions => $post_restrictions,
clout_types_ar => $clout_types_ar,
}, 1);
}
#################################################################
# this is to allow alternate parameters to be specified. pass in
# your hash reference to be passed to setUser(), and this will
# add in those extra parameters. add the parameters to string_param,
# type = otherusersparam, code = name of the param. they will
# be checked for the main user prefs editing screens, and on
# user creation -- pudge
sub getOtherUserParams {
my($data) = @_;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $user = getCurrentUser();
my $form = getCurrentForm();
my $params = $reader->getDescriptions('otherusersparam');
for my $param (keys %$params) {
if (exists $form->{$param}) {
# set user too for output in this request
$data->{$param} = $user->{$param} = $form->{$param} || undef;
}
}
}
###############################################################
# This modifies a hashref to default values -- if nothing
# else we assume the empty string which clears items in the
# user_param table
#
# takes 3 hashrefs currently
# $data - hashref to change to defaults
# $skip - hashref of keys to skip modifying
# $defaults - hashref of defaults to set to something other
# than the empty string
sub setToDefaults {
my($data, $skip, $defaults) = @_;
foreach my $key (keys %$data) {
next if $skip->{$key};
$data->{$key} = exists $defaults->{$key} ? $defaults->{$key} : "";
}
}
#################################################################
sub getCommentListing {
my ($type, $value,
$min_comment, $time_period, $cc_all, $cc_time_period, $cid_for_time_period,
$non_admin_limit, $admin_time_limit, $admin_non_time_limit,
$options) = @_;
my $reader = getObject('Slash::DB', { db_type => 'reader' });
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $store_cutoff = $options->{use_uid_cid_cutoff} ? $constants->{store_com_page1_min_cid_for_user_com_cnt} : 0;
my $s_opt = {};
my $num_wanted = 0;
if ($min_comment) {
if ($user->{is_admin}) {
$num_wanted = $admin_non_time_limit;
} else {
$num_wanted = $non_admin_limit;
}
} else {
if ($user->{is_admin}) {
if ($cc_time_period >= $admin_non_time_limit) {
$s_opt->{cid_at_or_after} = $cid_for_time_period;
$num_wanted = $admin_time_limit;
} else {
$num_wanted = $admin_non_time_limit;
if($store_cutoff){
my $min_cid = $reader->getUser($value,
"com_num_".$num_wanted."_at_or_after_cid");
$s_opt->{cid_at_or_after} = $min_cid
if $min_cid && $min_cid =~ /^\d+$/;
}
}
} else {
if ($cc_time_period >= $non_admin_limit ) {
$s_opt->{cid_at_or_after} = $cid_for_time_period;
$num_wanted = $non_admin_limit;
} else {
$num_wanted = $non_admin_limit;
if($store_cutoff){
my $min_cid = $reader->getUser($value,
"com_num_".$num_wanted."_at_or_after_cid");
$s_opt->{cid_at_or_after} = $min_cid
if $min_cid && $min_cid =~ /^\d+$/;
}
}
}
}
if ($type eq "uid") {
my $comments = $reader->getCommentsByUID($value, $num_wanted, $min_comment, $s_opt) if $cc_all;
if ($store_cutoff
&& $comments && $cc_all >= $store_cutoff && $min_comment == 0
&& scalar(@$comments) == $num_wanted) {
my $min_cid = 0;
for my $comment (@$comments) {
$min_cid = $comment->{cid}
if !$min_cid || ($comment->{cid} < $min_cid);
}
if ($min_cid && $min_cid =~/^\d+$/) {
$slashdb->setUser($value, {
"com_num_".$num_wanted."_at_or_after_cid" => $min_cid
});
}
}
return $comments;
} elsif ($type eq "ipid"){
return $reader->getCommentsByIPID($value, $num_wanted, $min_comment, $s_opt) if $cc_all;
} elsif ($type eq "subnetid"){
return $reader->getCommentsBySubnetID($value, $num_wanted, $min_comment, $s_opt) if $cc_all;
} else {
return $reader->getCommentsByIPIDOrSubnetID($value, $num_wanted, $min_comment, $s_opt) if $cc_all;
}
}
createEnvironment();
main();
1;