src/newslash_web/lib/Newslash/Model/Moderations.pm

   1 package Newslash::Model::Moderations;
   2 use Newslash::Model::Base -base;
   3
   4 use Data::Dumper;
   5
   6 # parameters
   7
   8 my $karma_posting_penalty_style = 0;
   9 my $badkarma = -10;
  10 my $goodkarma = 25;
  11 my $comment_minscore = -1;
  12 my $comment_maxscore = 5;
  13
  14 my $mod_params = {
  15                   maxkarma => 50,
  16                   minkarma => -25,
  17                   comment_minscore => -1,
  18                   comment_maxscore => 5,
  19                   modreasons_select_disabled => 255,
  20                  };
  21
  22 #========================================================================
  23
  24 =head2 score_for_comment_post(\%user)
  25
  26 calculate score for comment post
  27
  28 =over 4
  29
  30 =item Parameters
  31
  32 =over 4
  33
  34 =item \%user
  35
  36 user
  37
  38 =back
  39
  40 =item Return value
  41
  42 HASH of scores
  43
  44 =back
  45
  46 =cut
  47
  48 sub score_for_comment_post {
  49     my ($self, $user) = @_;
  50
  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');
  54
  55     my $pts = $user_comment->{defaultpoints};
  56     my $karma_bonus = 'no';
  57     my $tweak = 0;
  58
  59     if ($user->{login}) {
  60         my $karma = $user_info->{karma};
  61         if ($karma_posting_penalty_style == 0) {
  62             $pts-- if $karma < 0;
  63             $pts-- if $karma < $badkarma;
  64         }
  65         else {
  66             $tweak-- if $karma < 0;
  67             $tweak-- if $karma < $badkarma;
  68         }
  69
  70         # check if point is valid range
  71         if ($pts < $comment_minscore) {
  72             $pts = $comment_minscore;
  73         }
  74         elsif ($pts > $comment_maxscore) {
  75             $pts = $comment_maxscore;
  76         }
  77
  78         if ($pts >= 1 && $karma > $goodkarma) {
  79             $karma_bonus = 'yes';
  80         }
  81     }
  82
  83     return {points => $pts, karma_bonus => $karma_bonus, tweak => $tweak};
  84 }
  85
  86 #========================================================================
  87
  88 =head2 undo_moderation($type, $id, $uid)
  89
  90 undo moderations for comments in discussion from the user.
  91
  92 =over 4
  93
  94 =item Parameters
  95
  96 =over 4
  97
  98 =item $type
  99
 100 'discussion_id' or 'sid' or 'stoid'
 101
 102 =item $id
 103
 104 target id
 105
 106 =item $uid
 107
 108 target user's uid
 109
 110 =back
 111
 112 =item Return value
 113
 114 =back
 115
 116 =cut
 117
 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!
 122
 123     if ($type eq 'sid'
 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};
 128     }
 129     elsif ($type eq 'discussion_id') {
 130         $sid = $id;
 131     }
 132     else {
 133         return;
 134     }
 135
 136     my $dbh = $self->connect_db({AutoCommit => 0,});
 137     my $sql = <<"EOSQL";
 138 SELECT id, cid, val, active, cuid, reason FROM moderatorlog
 139   WHERE ? = ? AND uid = ?
 140 EOSQL
 141     my $sth = $dbh->prepare($sql);
 142     $sth->execute($type, $id, $uid);
 143     my $target = $sth->fetchall_arrayref({});
 144
 145     for my $mod (@$target) {
 146         next if !$mod->{active};
 147         my $cid = $mod->{cid};
 148
 149         $self->removeModTags($uid, $cid);
 150
 151         my $adjust = -$mod->{val};
 152         $adjust =~ s/^([^+-])/+$1/;
 153
 154         # Restore modded user's karma, again within the proper boundaries.
 155         if ($mod->{cuid} != 1) {
 156             my $adjust_abs = abs($adjust);
 157             my $set_clause;
 158             my $karma_limit;
 159             if ($adjust > 0) {
 160                 $set_clause = "karma = LEAST(?, karma + ?)";
 161                 $karma_limit = $mod_params->{maxkarma};
 162             }
 163             else {
 164                 $set_clause = "karma = GREATEST(?, karma + ?)";
 165                 $karma_limit = $mod_params->{minkarma};
 166             }
 167             my $rs = $dbh->do("UPDATE users_info SET $set_clause WHERE uid = ?", undef,
 168                               $karma_limit, $adjust, $mod->{cuid});
 169         }
 170
 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.
 174         my $set_clause;
 175         my $score_limit;
 176         if ($adjust > 0) {
 177             $set_clause = "points = LEAST(?, points + ?)";
 178             $score_limit = $mod_params->{comment_minscore};
 179         }
 180         else {
 181             $set_clause = "points = GREATEST(?, points + ?)";
 182             $score_limit = $mod_params->{comment_maxscore};
 183         }
 184
 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});
 189     }
 190
 191     $sql = <<"EOSQL";
 192 UPDATE moderatorlog SET active = 0
 193   WHERE sid = ? AND uid = ? AND active = 1
 194 EOSQL
 195     my $rs = $dbh->do($sql, undef, $sid, $uid);
 196     if (!$rs) {
 197         return;
 198     }
 199
 200     $dbh->disconnect;
 201     return $target;
 202 }
 203
 204 #========================================================================
 205
 206 =head2 removeModTags($uid, $cid)
 207
 208 remove moderation tags
 209
 210 =over 4
 211
 212 =item Parameters
 213
 214 =over 4
 215
 216 =item $uid
 217
 218 target user's uid
 219
 220 =item $cid
 221
 222 target id
 223
 224 =item $uid
 225
 226 =back
 227
 228 =item Return value
 229
 230 =back
 231
 232 =cut
 233
 234 sub removeModTags {
 235     my($self, $uid, $cid) = @_;
 236     my $globjids = $self->new_instance_of("Newslash::Model::Globjids");
 237
 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});
 242     }
 243 }
 244
 245 sub getReasons {
 246     my ($self) = @_;
 247
 248     my $dbh = $self->connect_db;
 249     my $sth = $dbh->prepare("SELECT * FROM modreasons");
 250     $sth->execute;
 251     my $rs = $sth->fetchall_hashref('id');
 252     $dbh->disconnect;
 253
 254     if (!%$rs) {
 255         return;
 256     }
 257     #my $table_cache = "_reasons_cache";
 258     #return {( %{$self->{$table_cache}} )} if ($self->{$table_cache});
 259
 260     #$self->{$table_cache} = $self->sqlSelectAllHashref(
 261     #                                                   "id", "*", "modreasons"
 262     #                                                  );
 263
 264     #my $mrd = getCurrentStatic('modreasons_select_disabled') || '';
 265     my $mrd = $mod_params->{modreasons_select_disabled} || '';
 266     foreach my $d (split(/,/, $mrd)) {
 267         $d = int($d);
 268         #$self->{$table_cache}{$d}{select_disabled} = 1;
 269         $rs->{$d}->{select_disabled} = 1;
 270     }
 271     #return {( %{$self->{$table_cache}} )};
 272     return $rs;
 273 }
 274
 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');
 285
 286     $new_reason = 0 if !$new_reason;
 287     unshift @tiebreaker_reasons, $new_reason if $new_reason;
 288
 289     my $reasons = $self->getReasons;
 290     my $listable_reasons = join(",",
 291                                 sort grep { $reasons->{$_}{listable} }
 292                                 keys %$reasons);
 293     return undef if !$listable_reasons;
 294
 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
 298     # to do a DB query.
 299     my $hr = { };
 300     if ($allreasons_hr) {
 301         for my $reason (%$allreasons_hr) {
 302             $hr->{$reason} = $allreasons_hr->{$reason}
 303               if $reasons->{$reason}{listable};
 304         }
 305     } else {
 306         $hr = $db->sqlSelectAllHashref(
 307                                        "reason",
 308                                        "reason, COUNT(*) AS c",
 309                                        "moderatorlog",
 310                                        "cid=$cid AND active=1
 311                                                  AND reason IN ($listable_reasons)",
 312                                        "GROUP BY reason"
 313                                       );
 314     }
 315
 316     # If no mods that are listable, return undef.
 317     return undef if !keys %$hr;
 318
 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");
 333     if ($new_reason) {
 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};
 337     }
 338     my $needval = $points - $pointsorig;
 339     if ($needval) {
 340         if ($needval >  1) { $needval =  1 }
 341         elsif ($needval < -1) { $needval = -1 }
 342         my $new_hr = { };
 343         for my $reason (keys %$hr) {
 344             $new_hr->{$reason} = $hr->{$reason}
 345               if $reasons->{$hr->{$reason}{reason}}{val} == $needval;
 346         }
 347         $hr = $new_hr;
 348     }
 349
 350     # If no mods that are listable, return undef.
 351     return undef if !keys %$hr;
 352
 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}
 357           ||
 358           $a <=> $b
 359       } keys %$hr;
 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];
 367     }
 368
 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};
 374     }
 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];
 379 }
 380
 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;
 390     return $entry;
 391 }
 392
 393
 394 1;