#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2001 by Open Source Development Network. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id: comments.pl,v 1.26.2.106 2002/07/03 17:06:09 pudge Exp $
use strict;
#use Date::Manip; # is this needed? -- pudge
use HTML::Entities;
use Slash;
use Slash::Display;
use Slash::Utility;
use constant MSG_CODE_COMMENT_MODERATE => 3;
use constant MSG_CODE_COMMENT_REPLY => 4;
##################################################################
sub main {
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $form = getCurrentForm();
my $user = getCurrentUser();
my $error_flag = 0;
my $postflag = $user->{state}{post};
my $op = lc($form->{op});
my($formkey, $stories);
######################################################
my $ops = {
# there will only be a discussions creation form if
# the user is anon, or if there's an sid, therefore, we don't want
# a formkey if it's not a form
display => {
function => \&displayComments,
seclev => 0,
formname => 'discussions',
checks => ($form->{sid} || isAnon($user->{uid})) ? [] : ['generate_formkey'],
},
change => {
function => \&displayComments,
seclev => 0,
formname => 'discussions',
checks => ($form->{sid} || isAnon($user->{uid})) ? [] : ['generate_formkey'],
},
'index' => {
function => \&commentIndex,
seclev => 0,
formname => 'discussions',
checks => ($form->{sid} || isAnon($user->{uid})) ? [] : ['generate_formkey'],
},
creator_index => {
function => \&commentIndexCreator,
seclev => 0,
formname => 'discussions',
checks => ['generate_formkey'],
},
personal_index => {
function => \&commentIndexPersonal,
seclev => 1,
formname => 'discussions',
checks => ['generate_formkey'],
},
moderate => {
function => \&moderate,
seclev => 1,
post => 1,
formname => 'moderate',
checks => ['generate_formkey'],
},
creatediscussion => {
function => \&createDiscussion,
seclev => 1,
post => 1,
formname => 'discussions',
checks =>
[ qw ( max_post_check valid_check interval_check
formkey_check regen_formkey ) ],
},
reply => {
function => \&editComment,
formname => 'comments',
seclev => 0,
checks =>
[ qw ( max_post_check generate_formkey ) ],
},
edit => {
function => \&editComment,
seclev => 0,
formname => 'comments',
checks =>
[ qw ( max_post_check update_formkeyid generate_formkey ) ],
},
preview => {
function => \&editComment,
seclev => 0,
formname => 'comments',
checks =>
[ qw ( update_formkeyid max_post_check ) ],
},
post => {
function => \&editComment,
seclev => 0,
formname => 'comments',
checks =>
[ qw ( update_formkeyid max_post_check generate_formkey ) ],
},
submit => {
function => \&submitComment,
seclev => 0,
post => 1,
formname => 'comments',
checks =>
[ qw ( response_check update_formkeyid max_post_check valid_check interval_check
formkey_check ) ],
},
};
$ops->{default} = $ops->{display} ;
# This is here to save a function call, even though the
# function can handle the situation itself
my ($discussion, $section);
if ($form->{sid}) {
# SID compatibility
if ($form->{sid} !~ /^\d+$/) {
$discussion = $slashdb->getDiscussionBySid($form->{sid});
$section = $discussion->{section};
} else {
$discussion = $slashdb->getDiscussion($form->{sid});
$section = $discussion->{section};
}
if (!$user->{is_admin} and $discussion->{sid}) {
unless ($slashdb->checkStoryViewable($discussion->{sid})) {
$form->{sid} = '';
$discussion = '';
$op = 'default';
$section = '';
}
}
}
$form->{pid} ||= "0";
header($discussion ? $discussion->{'title'} : 'Comments', $section);
if ($user->{is_anon} && length($form->{upasswd}) > 1) {
print getError('login error');
$op = 'preview';
}
$op = 'default' if ( ($user->{seclev} < $ops->{$op}{seclev}) || ! $ops->{$op}{function});
$op = 'default' if (! $postflag && $ops->{$op}{post});
# authors shouldn't jump through formkey hoops? right?
if ($user->{seclev} < 100) {
$formkey = $form->{formkey};
# this is needed for formkeyHandler to print the correct messages
# yeah, the next step is to loop through the array of $ops->{$op}{check}
for my $check (@{$ops->{$op}{checks}}) {
$ops->{$op}{update_formkey} = 1 if $check eq 'formkey_check';
my $formname = $ops->{$op}{formname};
$error_flag = formkeyHandler($check, $formname, $formkey);
last if $error_flag;
}
}
if (! $error_flag) {
# CALL THE OP
my $retval = $ops->{$op}{function}->($form, $slashdb, $user, $constants, $discussion);
# this has to happen - if this is a form that you updated the formkey val ('formkey_check')
# you need to call updateFormkey to update the timestamp (time of successful submission) and
# note: maxCid and length aren't really required - this is legacy from when formkeys was
# comments specific, but it can't hurt to put some sort of length in there.. perhaps
# the length of the primary field in your form would be a good choice.
if ($ops->{$op}{update_formkey}) {
if($retval) {
my $field_length= $form->{postercomment} ?
length($form->{postercomment}) : length($form->{postercomment});
# do something with updated? ummm.
my $updated = $slashdb->updateFormkey($formkey, $field_length);
# updateFormkeyVal updated the formkey before the function call,
# but the form somehow had an error in the function it called
# unrelated to formkeys so reset the formkey because this is
# _not_ a successful submission
} else {
my $updated = $slashdb->resetFormkey($formkey);
}
}
}
writeLog($form->{sid});
footer();
}
#################################################################
# this groups all the errors together in
# one template, called "errors;comments;default"
# Why not just getData??? -Brian
sub getError {
my($value, $hashref, $nocomm) = @_;
$hashref ||= {};
$hashref->{value} = $value;
return slashDisplay('errors', $hashref,
{ Return => 1, Nocomm => $nocomm });
}
##################################################################
sub delete {
my($form, $slashdb, $user, $constants) = @_;
titlebar("99%", "Delete $form->{cid}");
my $delCount = deleteThread($form->{sid}, $form->{cid});
$slashdb->setDiscussionDelCount($form->{sid}, $delCount);
$slashdb->setStory($form->{sid}, { writestatus => 'dirty' });
}
##################################################################
sub displayComments {
my($form, $slashdb, $user, $constants, $discussion) = @_;
if (defined $form->{'savechanges'} && !$user->{is_anon}) {
$slashdb->setUser($user->{uid}, {
threshold => $user->{threshold},
mode => $user->{mode},
commentsort => $user->{commentsort}
});
}
if ($form->{cid}) {
printComments($discussion, $form->{cid}, $form->{cid});
} elsif ($form->{sid}) {
printComments($discussion, $form->{pid});
} else {
commentIndex(@_);
}
}
##################################################################
# Index of recent discussions: Used if comments.pl is called w/ no
# parameters
sub commentIndex {
my($form, $slashdb, $user, $constants) = @_;
titlebar("90%", getData('active_discussions'));
if ($form->{all}) {
my $discussions = $slashdb->getDiscussions($form->{section});
slashDisplay('discuss_list', {
discussions => $discussions,
});
} else {
my $discussions = $slashdb->getStoryDiscussions($form->{section});
slashDisplay('discuss_list', {
discussions => $discussions,
});
}
}
##################################################################
# Index of recent discussions: Used if comments.pl is called w/ no
# parameters
sub commentIndexCreator {
my($form, $slashdb, $user, $constants) = @_;
my($uid, $nickname);
if ($form->{uid} or $form->{nick}) {
$uid = $form->{uid} ? $form->{uid} : $slashdb->getUserUID($form->{nick});
$nickname = $slashdb->getUser($uid, 'nickname');
} else {
$uid = $user->{uid};
$nickname = $user->{nickname};
}
if (isAnon($uid)) {
return displayComments(@_);
}
titlebar("90%", getData('user_discussion', { name => $nickname}));
my $discussions = $slashdb->getDiscussionsByCreator($uid);
if (@$discussions) {
slashDisplay('discuss_list', {
discussions => $discussions,
supress_create => 1,
});
} else {
print getData('users_no_discussions');
}
}
##################################################################
# Index of recent discussions: Used if comments.pl is called w/ no
# parameters
sub commentIndexPersonal {
my($form, $slashdb, $user, $constants) = @_;
titlebar("90%", getData('user_discussion', { name => $user->{nickname}}));
my $discussions = $slashdb->getDiscussionsByCreator($user->{uid});
if (@$discussions) {
slashDisplay('discuss_list', {
discussions => $discussions,
});
} else {
print getData('users_no_discussions');
}
}
##################################################################
# Yep, I changed the l33t method of adding discussions.
# "The Slash job, keeping trolls on their toes"
# -Brian
sub createDiscussion {
my($form, $slashdb, $user, $constants) = @_;
my $id;
if ($user->{seclev} >= $constants->{discussion_create_seclev}) {
# if form.url is empty, try the REFERER. if it
# matches comments.pl without any query string,
# then (later, down below) set url to point to discussion
# itself.
# this only catches URLs without query string ...
# we don't want to override prefs too easily. this
# can be modified to become more inclusive later,
# if needed. -- pudge
my $newurl = $form->{url}
? $form->{url}
: $ENV{HTTP_REFERER} =~ m|\Q$constants->{rootdir}/comments.pl\E$|
? ""
: $ENV{HTTP_REFERER};
$form->{url} = fudgeurl($newurl);
$form->{title} = strip_notags($form->{title});
# for now, use the postersubj filters; problem is,
# the error messages can come out a bit funny.
# oh well. -- pudge
my($error, $err_message);
if (! filterOk('comments', 'postersubj', $form->{title}, \$err_message)) {
$error = getError('filter message', {
err_message => $err_message
});
} elsif (! compressOk('comments', 'postersubj', $form->{title})) {
$error = getError('compress filter', {
ratio => 'postersubj',
});
} else {
# BTW we are not setting section since at this point we wouldn't
# trust users to set it correctly -Brian
$id = $slashdb->createDiscussion({
title => $form->{title},
topic => $form->{topic},
url => $form->{url} || 1,
type => "recycle"
});
# fix URL to point to discussion if no referer
if (!$form->{url}) {
$newurl = $constants->{rootdir} . "/comments.pl?sid=$id";
$slashdb->setDiscussion($id, { url => $newurl });
}
}
my $formats = $slashdb->getDescriptions('postmodes');
my $postvar = $form->{posttype} ? $form : $user;
my $format_select = createSelect(
'posttype', $formats, $postvar->{posttype}, 1
);
# Update form with the new SID for comment creation and other
# variables necessary. See "edit_comment;misc;default".
my $newform = {
sid => $id,
pid => 0,
title => $form->{title},
formkey => $form->{formkey},
};
# We COULD drop ID from the call below, but not right now.
slashDisplay('newdiscussion', {
error => $error,
form => $newform,
format_select => $format_select,
id => $id,
});
} else {
slashDisplay('newdiscussion', {
error => getError('seclevtoolow'),
});
}
commentIndex(@_);
}
##################################################################
# Welcome to one of the ancient beast functions. The comment editor
# is the form in which you edit a comment.
sub editComment {
my($form, $slashdb, $user, $constants, $discussion, $error_message) = @_;
my $preview;
my $error_flag = 0;
# Get the comment we may be responding to. Remember to turn off
# moderation elements for this instance of the comment.
my $reply = $slashdb->getCommentReply($form->{sid}, $form->{pid});
if (!$constants->{allow_anonymous} && $user->{is_anon}) {
print getError('no anonymous posting');
return;
}
if ($discussion->{type} eq 'archived') {
print getError('archive_error');
return;
}
if (lc($form->{op}) ne 'reply' || $form->{op} eq 'preview' || ($form->{postersubj} && $form->{postercomment})) {
$preview = previewForm(\$error_message) or $error_flag++;
}
if ($form->{pid} && !$form->{postersubj}) {
$form->{postersubj} = decode_entities($reply->{subject});
$form->{postersubj} =~ s/^Re://i;
$form->{postersubj} =~ s/\s\s/ /g;
$form->{postersubj} = "Re:$form->{postersubj}";
}
my $formats = $slashdb->getDescriptions('postmodes');
my $format_select = $form->{posttype}
? createSelect('posttype', $formats, $form->{posttype}, 1)
: createSelect('posttype', $formats, $user->{posttype}, 1);
my $approved_tags =
join "\n", map { "\t\t\t<$_>" } @{$constants->{approvedtags}};
slashDisplay('edit_comment', {
error_message => $error_message,
format_select => $format_select,
preview => $preview,
reply => $reply,
});
}
##################################################################
# Validate comment, looking for errors
sub validateComment {
my($comm, $subj, $error_message, $preview) = @_;
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $form = getCurrentForm();
my $form_success = 1;
my $message = '';
if ($slashdb->checkReadOnly('comments')) {
$$error_message = getError('readonly');
$form_success = 0;
# editComment('', $$error_message), return unless $preview;
return unless $preview;
}
if (isTroll()) {
$$error_message = getError('troll message');
return;
}
if (!$constants->{allow_anonymous} && ($user->{is_anon} || $form->{postanon})) {
$$error_message = getError('anonymous disallowed');
return;
}
unless ($$comm && $$subj) {
$$error_message = getError('no body');
return;
}
$$subj =~ s/\(Score(.*)//i;
$$subj =~ s/Score:(.*)//i;
unless (defined($$comm = balanceTags($$comm, $constants->{nesting_maxdepth}))) {
# This error message never gets seen because one or more later
# errors overwrite it.
$$error_message = getError('nesting too deep');
# editComment('', $$error_message), return unless $preview;
return unless $preview;
}
my $dupRows = $slashdb->findCommentsDuplicate($form->{sid}, $$comm);
if ($dupRows || !$form->{sid}) {
$$error_message = getError('validation error', {
dups => $dupRows,
});
# editComment('', $$error_message), return unless $preview;
return unless $preview;
# return;
}
if (length($$comm) > 100) {
local $_ = $$comm;
my($w, $br); # Words & BRs
$w++ while m/\w/g;
$br++ while m/
/gi;
# Should the naked '7' be converted to a Slash Variable for return by
# getCurrentStatic(). - Cliff
if (($w / ($br + 1)) < 7) {
$$error_message = getError('low words-per-line', {
ratio => $w / ($br + 1),
});
# editComment('', $$error_message), return unless $preview;
return unless $preview;
# return;
}
}
# test comment and subject using filterOk. If the filter is
# matched against the content, display an error with the
# particular message for the filter that was matched
my $fields = {
postersubj => $$subj,
postercomment => $$comm,
};
for (keys %$fields) {
# run through filters
if (! filterOk('comments', $_, $fields->{$_}, \$message)) {
$$error_message = getError('filter message', {
err_message => $message,
});
$form_success = 0;
# editComment('', $$error_message), return unless $preview;
return unless $preview;
last;
}
# run through compress test
if (! compressOk('comments', $_, $fields->{$_})) {
# blammo luser
$$error_message = getError('compress filter', {
ratio => $_,
});
#editComment('', $$error_message), return unless $preview;
return unless $preview;
$form_success = 0;
last;
}
}
$$error_message ||= '';
# Return false if error condition...
return if ! $form_success;
# ...otherwise return true.
return 1;
}
##################################################################
# Previews a comment for submission
sub previewForm {
my($error_message) = @_;
my $form = getCurrentForm();
my $user = getCurrentUser();
my $slashdb = getCurrentDB();
$user->{sig} = "" if $form->{postanon};
my $tempSubject = strip_notags($form->{postersubj});
my $tempComment = $form->{postercomment};
validateComment(\$tempComment, \$tempSubject, $error_message, 1) or return;
$tempComment = strip_mode($form->{postercomment}, $form->{posttype});
$tempComment = addDomainTags($tempComment);
$tempComment = parseDomainTags($tempComment,
!$form->{postanon} && $user->{fakeemail});
my $sig = $user->{sig};
if ($user->{sigdash} && $user->{sig}) {
$sig = "--
$sig";
}
my $preview = {
nickname => $form->{postanon}
? getCurrentAnonymousCoward('nickname')
: $user->{nickname},
pid => $form->{pid},
homepage => $form->{postanon} ? '' : $user->{homepage},
fakeemail => $form->{postanon} ? '' : $user->{fakeemail},
'time' => $slashdb->getTime(),
subject => $tempSubject,
comment => $tempComment,
sig => $sig,
};
my $tm = $user->{mode};
$user->{mode} = 'archive';
my $previewForm;
if ($tempSubject && $tempComment) {
$previewForm = slashDisplay('preview_comm', {
preview => $preview,
}, 1);
}
$user->{mode} = $tm;
return $previewForm;
}
##################################################################
# Saves the Comment
# A note, right now form->{sid} is a discussion id, not a
# story id.
sub submitComment {
my($form, $slashdb, $user, $constants, $discussion) = @_;
if ($discussion->{type} eq 'archived') {
print getError('archive_error');
return;
}
my $error_message;
$form->{postersubj} = strip_notags($form->{postersubj});
my $tempComment = $form->{postercomment};
unless (validateComment(\$tempComment, \$form->{postersubj}, \$error_message)) {
$slashdb->resetFormkey($form->{formkey});
editComment(@_, $error_message);
return(0);
}
$tempComment = strip_mode($tempComment, $form->{posttype});
$form->{postercomment} = addDomainTags($tempComment);
# # Slash is not a file exchange system
# # still working on this...stay tuned for real commit
# # (maybe in 2.4... sigh)
# $form->{postercomment} = distressBinaries($form->{postercomment});
# this has to be a template -- pudge
titlebar("95%", "Submitted Comment");
my $pts = 0;
if (!$user->{is_anon} && !$form->{postanon}) {
$pts = $user->{defaultpoints};
$pts-- if $user->{karma} < 0;
$pts-- if $user->{karma} < $constants->{badkarma};
$pts++ if $pts >= 1 && $user->{karma} > $constants->{goodkarma}
&& !$form->{nobonus};
# Enforce proper ranges on comment points.
my($minScore, $maxScore) =
($constants->{comment_minscore}, $constants->{comment_maxscore});
$pts = $minScore if $pts < $minScore;
$pts = $maxScore if $pts > $maxScore;
}
# This is here to prevent posting to discussions that don't exist/are nd -Brian
unless ($user->{is_admin}) {
unless ($slashdb->checkDiscussionPostable($form->{sid})) {
print getError('submission error');
return(0);
}
}
my $maxCid = $slashdb->createComment(
$form,
$user,
$pts,
$constants->{anonymous_coward_uid}
);
# make the formkeys happy
$form->{maxCid} = $maxCid;
$slashdb->setUser($user->{uid}, {
'-expiry_comm' => 'expiry_comm-1',
}) if allowExpiry();
if ($maxCid == -1) {
# What vars should be accessible here?
print getError('submission error');
return(0);
} elsif (!$maxCid) {
# What vars should be accessible here?
# - $maxCid?
# What are the odds on this happening? Hmmm if it is we should
# increase the size of int we used for cid.
print getError('maxcid exceeded');
return(0);
} else {
slashDisplay('comment_submit');
undoModeration($form->{sid});
printComments($discussion, $maxCid, $maxCid);
my $tc = $slashdb->getVar('totalComments', 'value');
$slashdb->setVar('totalComments', ++$tc);
# This is for stories. If a sid is only a number
# then it belongs to discussions, if it has characters
# in it then it belongs to stories and we should
# update to help with stories/hitparade.
# -Brian
if ($discussion->{sid}) {
$slashdb->setStory($discussion->{sid}, { writestatus => 'dirty' });
}
$slashdb->setUser($user->{uid}, {
-totalcomments => 'totalcomments+1',
});
my $messages = getObject('Slash::Messages') if $form->{pid};
if ($form->{pid} && $messages) {
my $parent = $slashdb->getCommentReply($form->{sid}, $form->{pid});
my $users = $messages->checkMessageCodes(MSG_CODE_COMMENT_REPLY, [$parent->{uid}]);
if (@$users) {
my $reply = $slashdb->getCommentReply($form->{sid}, $maxCid);
my $data = {
template_name => 'reply_msg',
subject => { template_name => 'reply_msg_subj' },
reply => $reply,
parent => $parent,
discussion => $discussion,
};
$messages->create($users->[0], MSG_CODE_COMMENT_REPLY, $data);
}
}
}
return(1);
}
##################################################################
# Handles moderation
# gotta be a way to simplify this -Brian
sub moderate {
my($form, $slashdb, $user, $constants, $discussion) = @_;
my $sid = $form->{sid};
my $was_touched = 0;
if ($discussion->{type} eq 'archived') {
print getData('archive_error');
return;
}
if (! $constants->{allow_moderation}) {
print getData('no_moderation');
return;
}
my $total_deleted = 0;
my $hasPosted;
# The content here should also probably go into a template.
titlebar("99%", "Moderating...");
$hasPosted = $slashdb->countCommentsBySidUID($sid, $user->{uid})
unless $user->{seclev} > 99 && $constants->{authors_unlimited};
slashDisplay('mod_header');
# Handle Deletions, Points & Reparenting
for my $key (sort keys %{$form}) {
if ($user->{seclev} > 100 and $key =~ /^del_(\d+)$/) {
$total_deleted += deleteThread($sid, $1);
} elsif (!$hasPosted and $key =~ /^reason_(\d+)$/) {
$was_touched += moderateCid($sid, $1, $form->{$key});
}
}
$slashdb->setDiscussionDelCount($sid, $total_deleted);
$was_touched = 1 if $total_deleted;
slashDisplay('mod_footer');
if ($hasPosted && !$total_deleted) {
print getError('already posted');
} elsif ($user->{seclev} && $total_deleted) {
slashDisplay('del_message', {
total_deleted => $total_deleted,
comment_count => $slashdb->countCommentsBySid($sid),
});
}
printComments($discussion, $form->{pid}, $form->{cid});
if ($was_touched) {
# This is for stories. If a sid is only a number
# then it belongs to discussions, if it has characters
# in it then it belongs to stories and we should
# update to help with stories/hitparade.
# -Brian
if ($discussion->{sid}) {
$slashdb->setStory($discussion->{sid}, { writestatus => 'dirty' });
}
}
}
##################################################################
# Handles moderation
# Moderates a specific comment. Returns whether the comment score changed.
sub moderateCid {
my($sid, $cid, $reason) = @_;
return 0 unless $reason;
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
my $comment_changed = 0;
my $superAuthor = $constants->{authors_unlimited};
if ($user->{points} < 1) {
unless ($user->{is_admin} && $superAuthor) {
print getError('no points');
return 0;
}
}
my $comment = $slashdb->getComment($cid);
# The user should not have been been presented with the menu
# to moderate if any of the following tests trigger, but,
# an unscrupulous user could have faked their submission with
# or without us presenting them the menu options. So do the
# tests again.
unless ($user->{is_admin}) {
# Do not allow moderation of any comments with the same UID as the
# current user (duh!).
return if $user->{uid} == $comment->{uid};
# Do not allow moderation of any comments (anonymous or otherwise)
# with the same IP as the current user.
return if $user->{ipid} eq $comment->{ipid};
# If the var forbids it, do not allow moderation of any comments
# with the same *subnet* as the current user.
return if $constants->{mod_same_subnet_forbid}
and $user->{subnetid} eq $comment->{subnetid};
}
my $dispArgs = {
cid => $cid,
sid => $sid,
subject => $comment->{subject},
reason => $reason,
points => $user->{points},
};
unless ($user->{seclev} > 99 and $superAuthor) {
my $mid = $slashdb->getModeratorLogID($cid, $user->{uid});
if ($mid) {
$dispArgs->{type} = 'already moderated';
slashDisplay('moderation', $dispArgs);
return 0;
}
}
my $modreason = $reason;
my $val = "-1";
if ($reason == 9) { # Overrated
$val = "-1";
$reason = $comment->{reason};
} elsif ($reason == 10) { # Underrated
$val = "+1";
$reason = $comment->{reason};
} elsif ($reason > $constants->{badreasons}) {
$val = "+1";
}
# Add moderation value to display arguments.
$dispArgs->{'val'} = $val;
my $scorecheck = $comment->{points} + $val;
my $active = 1;
# If the resulting score is out of comment score range, no further
# actions need be performed.
# Should we return here and go no further?
if ( $scorecheck < $constants->{comment_minscore} ||
$scorecheck > $constants->{comment_maxscore})
{
# We should still log the attempt for M2, but marked as
# 'inactive' so we don't mistakenly undo it. Mods get modded
# even if the action didn't "really" happen.
#
$active = 0;
$dispArgs->{type} = 'score limit';
}
# Write the proper records to the moderatorlog.
$slashdb->setModeratorLog($comment, $user->{uid}, $val, $modreason, $active);
if ($active) {
# Increment moderators total mods and deduct their point for playing.
# Word of note, if we are HERE, then the user either has points, or
# is an author (and 'author_unlimited' is set) so point checks SHOULD
# be unnecessary here.
$user->{points}-- if $user->{points} > 0;
$user->{totalmods}++;
$slashdb->setUser($user->{uid}, {
totalmods => $user->{totalmods},
points => $user->{points},
});
# Adjust comment posters karma and moderation stats.
if ($comment->{uid} != $constants->{anonymous_coward_uid}) {
my $cuser = $slashdb->getUser($comment->{uid});
my $newkarma = $cuser->{karma} + $val;
$cuser->{downmods}++ if $val < 0;
$cuser->{upmods}++ if $val > 0;
$cuser->{karma} = $newkarma
if $newkarma <= $constants->{maxkarma} &&
$newkarma >= $constants->{minkarma};
$slashdb->setUser($comment->{uid}, {
karma => $cuser->{karma},
upmods => $cuser->{upmods},
downmods => $cuser->{downmods},
});
}
# Make sure our changes get propagated back to the comment.
# Note that we use the ADJUSTED reason value, $reason.
$comment_changed =
$slashdb->setCommentCleanup($cid, $val, $reason);
if (!$comment_changed) {
# This shouldn't happen; the only way we believe it
# could is if $val is 0, the comment is already at
# min or max score, the user's already modded this
# comment, or some other reason making this mod invalid.
# This is really just here as a safety check.
$dispArgs->{type} = 'logic error';
slashDisplay('moderation', $dispArgs);
return 0;
}
# We know things actually changed, so update points for
# display and send a message if appropriate.
$dispArgs->{points} = $user->{points};
$dispArgs->{type} = 'moderated';
# Send messages regarding this moderation to user who posted
# comment if they have that bit set.
my $messages = getObject('Slash::Messages');
if ($messages) {
my $comm = $slashdb->getCommentReply($sid, $cid);
my $users = $messages->checkMessageCodes(
MSG_CODE_COMMENT_MODERATE, [$comment->{uid}]
);
if (@$users) {
my $discussion = $slashdb->getDiscussion($sid);
if ($discussion->{sid}) {
# Story discussion, link to it.
$discussion->{realurl} =
"$constants->{absolutedir}/article.pl?sid=$discussion->{sid}";
} else {
# Some other kind of discussion,
# probably poll, journal entry, or
# user-created; don't trust its url. -- jamie
# I really don't like this. I want users
# to be able to go to the poll or journal
# directly. we could consider matching a pattern
# for journal.pl or pollBooth.pl etc.,
# but that is not great. maybe a field in discussions
# for whether or not url is trusted. -- pudge
$discussion->{realurl} =
"$constants->{absolutedir}/comments.pl?sid=$discussion->{id}";
}
my $data = {
template_name => 'mod_msg',
subject => {
template_name => 'mod_msg_subj'
},
comment => $comm,
discussion => $discussion,
moderation => {
user => $user,
value => $val,
reason => $modreason,
},
};
$messages->create(
$users->[0],
MSG_CODE_COMMENT_MODERATE,
$data
);
}
}
}
# Now display the template with the moderation results.
slashDisplay('moderation', $dispArgs);
# Now in theory if we are here this is ok.
# I think there is kludge in the above logic at the moment.
# -Brian
return 1;
}
##################################################################
# Given an SID & A CID this will delete a comment, and all its replies
sub deleteThread {
my($sid, $cid, $level, $comments_deleted) = @_;
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
$level ||= 0;
my $count = 1;
my @delList;
$comments_deleted = \@delList if !$level;
return unless $user->{seclev} > 100;
my $delkids = $slashdb->getCommentChildren($cid);
# Delete children of $cid.
push @{$comments_deleted}, $cid;
for (@{$delkids}) {
my($cid) = @{$_};
push @{$comments_deleted}, $cid;
$count += deleteThread($sid, $cid, $level+1, $comments_deleted);
}
# And now delete $cid.
$count += $slashdb->deleteComment($cid);
if (!$level) {
# SID remains for display purposes, only.
slashDisplay('deleted_cids', {
sid => $sid,
count => $count,
comments_deleted => $comments_deleted,
});
}
return $count;
}
##################################################################
# If you moderate, and then post, all your moderation is undone.
sub undoModeration {
my($sid) = @_;
my $slashdb = getCurrentDB();
my $constants = getCurrentStatic();
my $user = getCurrentUser();
# We abandon this operation if:
# 1) Moderation is off
# 2) The user is anonymous (they aren't allowed to anyway).
# 3) The user is an author with a high enough security level
# and that option is turned on.
return if !$constants->{allow_moderation} || $user->{is_anon} ||
( $user->{seclev} > 99 && $constants->{authors_unlimited} &&
$user->{author} );
if ($sid !~ /^\d+$/) {
$sid = $slashdb->getDiscussionBySid($sid, 'header');
}
my $removed = $slashdb->undoModeration($user->{uid}, $sid);
slashDisplay('undo_mod', {
removed => $removed,
});
}
##################################################################
# Troll Detection: checks to see if this IP or UID has been
# abusing the system in the last 24 hours.
# 1=Troll 0=Good Little Goober
sub isTroll {
my $slashdb = getCurrentDB();
my $user = getCurrentUser();
my $form = getCurrentForm();
return 0 if $user->{seclev} >= 100;
my $good_behavior = 0;
if (!$user->{is_anon} and $user->{karma} >= 1) {
if ($form->{postanon}) {
# If the user is signed in but posting anonymously,
# their karma helps a little bit to offset their
# trollishness. But not much.
$good_behavior = int(log($user->{karma})+0.5);
} else {
# If the user is signed in with karma at least 1 and
# posts with their name, the IP ban doesn't apply.
return 0;
}
}
return $slashdb->getIsTroll($good_behavior);
}
##################################################################
createEnvironment();
main();
1;