1 package Newslash::Model::Moderations;
2 use Newslash::Model::Base -base;
8 my $karma_posting_penalty_style = 0;
11 my $comment_minscore = -1;
12 my $comment_maxscore = 5;
17 comment_minscore => -1,
18 comment_maxscore => 5,
19 modreasons_select_disabled => 255,
22 #========================================================================
24 =head2 score_for_comment_post(\%user)
26 calculate score for comment post
48 sub score_for_comment_post {
49 my ($self, $user) = @_;
51 my $users = $self->new_instance_of("Newslash::Model::Users");
52 my $user_comment = $users->select(uid => $user->{uid}, target => 'comments');
53 my $user_info = $users->select(uid => $user->{uid}, target => 'info');
55 my $pts = $user_comment->{defaultpoints};
56 my $karma_bonus = 'no';
60 my $karma = $user_info->{karma};
61 if ($karma_posting_penalty_style == 0) {
63 $pts-- if $karma < $badkarma;
66 $tweak-- if $karma < 0;
67 $tweak-- if $karma < $badkarma;
70 # check if point is valid range
71 if ($pts < $comment_minscore) {
72 $pts = $comment_minscore;
74 elsif ($pts > $comment_maxscore) {
75 $pts = $comment_maxscore;
78 if ($pts >= 1 && $karma > $goodkarma) {
83 return {points => $pts, karma_bonus => $karma_bonus, tweak => $tweak};
86 #========================================================================
88 =head2 undo_moderation($type, $id, $uid)
90 undo moderations for comments in discussion from the user.
100 'discussion_id' or 'sid' or 'stoid'
118 sub undo_moderation {
119 my ($self, $type, $id, $uid) = @_;
120 # type = sid or stoid or discussion_id
121 my $sid; # sid is discussion_id!
124 || $type eq 'stoid') {
125 my $stories = $self->new_instance_of("Newslash::Model::Stories");
126 my $story = $stories->select($type => $id);
127 $sid = $story->{discussion};
129 elsif ($type eq 'discussion_id') {
136 my $dbh = $self->connect_db({AutoCommit => 0,});
138 SELECT id, cid, val, active, cuid, reason FROM moderatorlog
139 WHERE ? = ? AND uid = ?
141 my $sth = $dbh->prepare($sql);
142 $sth->execute($type, $id, $uid);
143 my $target = $sth->fetchall_arrayref({});
145 for my $mod (@$target) {
146 next if !$mod->{active};
147 my $cid = $mod->{cid};
149 $self->removeModTags($uid, $cid);
151 my $adjust = -$mod->{val};
152 $adjust =~ s/^([^+-])/+$1/;
154 # Restore modded user's karma, again within the proper boundaries.
155 if ($mod->{cuid} != 1) {
156 my $adjust_abs = abs($adjust);
160 $set_clause = "karma = LEAST(?, karma + ?)";
161 $karma_limit = $mod_params->{maxkarma};
164 $set_clause = "karma = GREATEST(?, karma + ?)";
165 $karma_limit = $mod_params->{minkarma};
167 my $rs = $dbh->do("UPDATE users_info SET $set_clause WHERE uid = ?", undef,
168 $karma_limit, $adjust, $mod->{cuid});
171 # Adjust the comment score up or down, but don't push it
172 # beyond the maximum or minimum. Also recalculate its reason.
173 # Its pointsmax logically can't change.
177 $set_clause = "points = LEAST(?, points + ?)";
178 $score_limit = $mod_params->{comment_minscore};
181 $set_clause = "points = GREATEST(?, points + ?)";
182 $score_limit = $mod_params->{comment_maxscore};
185 # no active moderations? reset reason to empty
186 my $new_reason = $self->getCommentMostCommonReason($cid) || 0;
187 my $rs = $dbh->do("UPDATE comments SET $set_clause , reason = ? WHERE cid = ?", undef,
188 $score_limit, $adjust, $new_reason, $mod->{cuid});
192 UPDATE moderatorlog SET active = 0
193 WHERE sid = ? AND uid = ? AND active = 1
195 my $rs = $dbh->do($sql, undef, $sid, $uid);
204 #========================================================================
206 =head2 removeModTags($uid, $cid)
208 remove moderation tags
235 my($self, $uid, $cid) = @_;
236 my $globjids = $self->new_instance_of("Newslash::Model::Globjids");
238 my $comment_globjid = $globjids->getGlobjidFromTargetIfExists('comments', $cid);
239 if ($comment_globjid) {
240 my $tags = $self->new_instance_of("Newslash::Model::Tags");
241 $tags->deactivateTag({globjid => $comment_globjid, uid => $uid});
248 my $dbh = $self->connect_db;
249 my $sth = $dbh->prepare("SELECT * FROM modreasons");
251 my $rs = $sth->fetchall_hashref('id');
257 #my $table_cache = "_reasons_cache";
258 #return {( %{$self->{$table_cache}} )} if ($self->{$table_cache});
260 #$self->{$table_cache} = $self->sqlSelectAllHashref(
261 # "id", "*", "modreasons"
264 #my $mrd = getCurrentStatic('modreasons_select_disabled') || '';
265 my $mrd = $mod_params->{modreasons_select_disabled} || '';
266 foreach my $d (split(/,/, $mrd)) {
268 #$self->{$table_cache}{$d}{select_disabled} = 1;
269 $rs->{$d}->{select_disabled} = 1;
271 #return {( %{$self->{$table_cache}} )};
275 # This gets the mathematical mode, in other words the most common,
276 # of the moderations done to a comment. If no mods, return undef.
277 # If a comment's net moderation is down, choose only one of the
278 # negative mods, and the opposite for up. Tiebreakers break ties,
279 # first tiebreaker found wins. "cid" is a key in moderatorlog
280 # so this is not a table scan. It's currently called only by
281 # setCommentForMod and undoModeration.
282 sub getCommentMostCommonReason {
283 my ($self, $cid, $allreasons_hr, $new_reason, @tiebreaker_reasons) = @_;
284 my $db = $self->new_instance_of('LegacyDB');
286 $new_reason = 0 if !$new_reason;
287 unshift @tiebreaker_reasons, $new_reason if $new_reason;
289 my $reasons = $self->getReasons;
290 my $listable_reasons = join(",",
291 sort grep { $reasons->{$_}{listable} }
293 return undef if !$listable_reasons;
295 # Build the hashref of reason counts for this comment, for all
296 # listable reasons. If allreasoncounts_hr was passed in, this
297 # is easy (just grep out the nonlistable ones). If not, we have
300 if ($allreasons_hr) {
301 for my $reason (%$allreasons_hr) {
302 $hr->{$reason} = $allreasons_hr->{$reason}
303 if $reasons->{$reason}{listable};
306 $hr = $db->sqlSelectAllHashref(
308 "reason, COUNT(*) AS c",
310 "cid=$cid AND active=1
311 AND reason IN ($listable_reasons)",
316 # If no mods that are listable, return undef.
317 return undef if !keys %$hr;
319 # We need to know if the comment has been moderated net up,
320 # net down, or to a net tie, and if not a tie, restrict
321 # ourselves to choosing only reasons from that direction.
322 # Note this isn't atomic with the actual application of, or
323 # undoing of, the moderation in question. Oh well! If two
324 # mods are applied at almost exactly the same time, there's
325 # a one in a billion chance the comment will end up with a
326 # wrong (but still plausible) reason field. I'm not going
327 # to worry too much about it.
328 # Also, I'm doing this here, with a separate for loop to
329 # screen out unacceptable reasons, instead of putting this
330 # "if" into the same for loop above, because it may save a
331 # query (if a comment is modded entirely with Under/Over).
332 my($points, $pointsorig) = $db->sqlSelect("points, pointsorig", "comments", "cid=$cid");
334 # This mod hasn't been taken into account in the
335 # DB yet, but it's about to be applied.
336 $points += $reasons->{$new_reason}{val};
338 my $needval = $points - $pointsorig;
340 if ($needval > 1) { $needval = 1 }
341 elsif ($needval < -1) { $needval = -1 }
343 for my $reason (keys %$hr) {
344 $new_hr->{$reason} = $hr->{$reason}
345 if $reasons->{$hr->{$reason}{reason}}{val} == $needval;
350 # If no mods that are listable, return undef.
351 return undef if !keys %$hr;
353 # Sort first by popularity and secondarily by reason.
354 # "reason" is a numeric field, so we sort $a<=>$b numerically.
355 my @sorted_keys = sort {
356 $hr->{$a}{c} <=> $hr->{$b}{c}
360 my $top_count = $hr->{$sorted_keys[-1]}{c};
361 @sorted_keys = grep { $hr->{$_}{c} == $top_count } @sorted_keys;
362 # Now sorted_keys are only the top values, one or more of them,
363 # any of which could be the winning reason.
364 if (scalar(@sorted_keys) == 1) {
365 # A clear winner. Return it.
366 return $sorted_keys[0];
369 # No clear winner. Are any of our tiebreakers contenders?
370 my %sorted_hash = ( map { $_ => 1 } @sorted_keys );
371 for my $reason (@tiebreaker_reasons) {
372 # Yes, return the first tiebreaker we find.
373 return $reason if $sorted_hash{$reason};
375 # Nope, we don't have a good way to resolve the tie. Pick whatever
376 # comes first in the reason list (reasons are all numeric and
377 # sorted_keys is already sorted, making this easy).
378 return $sorted_keys[0];
381 sub getEntryPopularityForColorLevel {
382 my ($self, $level) = @_;
383 #my $constants = $self->getCurrentStatic();
384 #my $slicepoints = $constants->{firehose_slice_points};
385 #my $slicepoints = '290,240 220,200 185,175 155,138 102,93 30,25 0,-20 -60,-999999';
386 #my @levels = split / /, $slicepoints;
387 my @levels = split / /, "290,240 220,200 185,175 155,138 102,93 30,25 0,-20 -60,-999999";
388 my $entry_min = $levels[$level-1];
389 my($entry, $min) = split /,/, $entry_min;