Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 173 lines (146 sloc) 4.817 kb
#!/usr/bin/perl -w
###############################################################################
# moderatord - the moderation "daemon". Calculates moderation information and
# assigns results to users
#
# Copyright (C) 1997 Rob "CmdrTaco" Malda
# malda@slashdot.org
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#
# $Id$
###############################################################################
use strict;
use vars '%I';
use Slash;
*I = getSlashConf();
sub moderatordLog {
local *LOG;
my $dir = "$I{datadir}/logs";
open LOG, ">>$dir/moderatord.log"
or die "Can't append to $dir/moderatord.log: $!";
print LOG localtime() . "\t", join("\t", @_), "\n";
close LOG;
}
sub tokens2points {
my $c = sqlSelectMany("uid,tokens", "users_info", "tokens >= $I{maxtokens}");
$I{dbh}->do("LOCK TABLES users READ,
users_info WRITE,
users_comments WRITE");
while (my($uid, $tokens) = $c->fetchrow) {
moderatordLog("Giving $I{maxtokens}/$I{tokensperpoint} " .
($I{maxtokens}/$I{tokensperpoint}) . " to $uid");
sqlUpdate("users_info", {
-lastgranted => 'now()',
-tokens => "tokens - $I{maxtokens}"
}, "uid=$uid");
sqlUpdate("users_comments", {
-points => "points +" . ($I{maxtokens} / $I{tokensperpoint})
}, "uid=$uid");
}
$c->finish;
$c = sqlSelectMany("users.uid as uid", "users,users_comments,users_info",
"karma > -1 AND
points > 5 AND
seclev < 100 AND
users.uid=users_comments.uid AND
users.uid=users_info.uid");
$I{dbh}->do("UNLOCK TABLES");
$I{dbh}->do("LOCK TABLES users_comments WRITE");
while (my($uid) = $c->fetchrow) {
sqlUpdate("users_comments", { points => 5 } ,"uid=$uid");
}
$I{dbh}->do("UNLOCK TABLES");
}
sub stirpool {
my $c = sqlSelectMany("points,users.uid as uid",
"users,users_comments,users_info",
"users.uid=users_comments.uid AND
users.uid=users_info.uid AND
seclev = 0
AND points > 0
AND to_days(now())-to_days(lastgranted) > $I{stir}");
my $revoked = 0;
$I{dbh}->do("LOCK TABLES users_comments WRITE");
while (my($p, $u) = $c->fetchrow) {
moderatordLog("Taking $p points from $u");
$revoked += $p;
sqlUpdate("users_comments", { points => '0' }, "uid=$u");
}
$I{dbh}->do("UNLOCK TABLES");
$c->finish;
return 0;
# return $revoked;
}
sub comments2tokens {
my $comments = shift;
my $tokenpool = $comments * $I{tokenspercomment};
moderatordLog("$comments becomes $tokenpool tokens.");
my $stirredpoints = stirpool();
$tokenpool += $stirredpoints * $I{tokensperpoint};
moderatordLog(
($stirredpoints ? "Stirred out $stirredpoints points, " : '')
. "So the total token Pool=$tokenpool");
my($totalusers) = sqlSelect("max(uid)", "users_info");
my $eligibleusers = int($totalusers / 5) * 4;
moderatordLog("First $eligibleusers accounts available");
my $c=sqlSelectMany("users_info.uid,count(*) as c",
"users_info,users_prefs, accesslog",
"users_info.uid < $eligibleusers
AND users_info.uid=accesslog.uid
AND users_info.uid=users_prefs.uid
AND (op='article' or op='comments')
AND willing=1
AND karma >= 0
GROUP BY users_info.uid
ORDER BY c");
my $eligible = $c->rows;
my($uid, $cnt);
while ((($uid,$cnt) = $c->fetchrow) && ($cnt < 4)) {
$eligible--;
}
my($st, $fi) = (int($eligible / 6), int($eligible / 8) * 7);
my $x;
moderatordLog("Start at $st end at $fi. $eligible left. First score is $cnt");
my @eligibles;
while (($x++ < $fi) && (($uid, $cnt) = $c->fetchrow)) {
next if $x < $st;
push @eligibles, $uid;
# moderatordLog("$uid is eligible");
}
$c->finish;
my @scores;
for (my $x = 0; $x < $tokenpool; $x++) {
$scores[$eligibles[rand @eligibles]]++;
}
$I{dbh}->do("LOCK TABLES users_info WRITE");
foreach $uid (@eligibles) {
next unless $scores[$uid];
# moderatordLog("$uid: ".$scores[$uid].", ");
sqlUpdate("users_info",{
-tokens => "tokens+" . $scores[$uid]
}, "uid=$uid");
}
$I{dbh}->do("UNLOCK TABLES");
}
my($tc, $lc) = getvars("totalComments", "lastComments");
my $newcomments = $tc - $lc;
#$newcomments+=1000;
if ($newcomments > 0) {
setvar("lastComments", $tc);
comments2tokens($newcomments);
tokens2points();
}
Jump to Line
Something went wrong with that request. Please try again.