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

   1 package Newslash::Model::Metamoderations;
   2 use Newslash::Model::Base -base;
   3
   4 use Data::Dumper;
   5 use List::Util qw(sum any);
   6 use POSIX;
   7
   8 my $m2_params = {
   9                  m2_mintokes => 0,
  10                  m2_consensus => 9,
  11
  12                  count_threshold => 3,
  13                  agreement_threshold_ratio => 0.66,
  14                  prevent_params => {
  15                                     alpha => 0.85,
  16                                     beta => 0.43,
  17                                     min => 0.5,
  18                                     max => 1.0,
  19                                     min_count => 3,
  20                                     max_count => 20,
  21                                     reduction => 1.0,
  22                                    },
  23                  enforce_params => {
  24                                     alpha => 0.85,
  25                                     beta => 0.086,
  26                                     min => 0.05,
  27                                     max => 0.15,
  28                                     min_count => 3,
  29                                     max_count => 20,
  30                                     reduction => 0.1,
  31                                    },
  32                  token_unfair_params => {
  33                                        alpha => 0.56,
  34                                        beta => 21,
  35                                        min => 1.0,
  36                                        max => 20.0,
  37                                        min_count => 3,
  38                                        max_count => 20,
  39                                       },
  40                  token_fair_params => {
  41                                        alpha => 0.56,
  42                                        beta => 4.2,
  43                                        min => 0.2,
  44                                        max => 4.0,
  45                                        min_count => 3,
  46                                        max_count => 20,
  47                                       },
  48                 };
  49
  50 sub create {
  51     my ($self, $user, $moderation_id, $value) = @_;
  52     return if $self->check_readonly;
  53     my $moderations = $self->new_instance_of("Moderations");
  54     my $moderation = $moderations->select(id => $moderation_id);
  55     if (!$moderation) {
  56         $self->set_error("invalid moderation id");
  57         return;
  58     }
  59
  60     # user validation
  61     if (!$moderations->is_metamoderatable($user, $moderation)
  62         && !$user->{is_admin}
  63         && !$user->{editor} ) {
  64         $self->set_error("you cannot metamoderate the moderation");
  65         return;
  66     }
  67
  68     # when the user already metamoderated, return.
  69     my $m2check = $self->select(moderation_id => $moderation->{id},
  70                                 uid => $user->{uid});
  71     if (!$m2check || @$m2check != 0) {
  72         $self->set_error("you have already metamoderated");
  73         return;
  74     }
  75
  76     my $metamods = $self->select(moderation_id => $moderation->{id});
  77     if (!defined $metamods) {
  78         $self->set_error("metamoderations retrive error");
  79         return;
  80     }
  81     my $mods = $moderations->select(cid => $moderation->{cid});
  82     if (!defined $mods) {
  83         $self->set_error("moderations retrive error");
  84         return;
  85     }
  86
  87     # calc unchanged moderation's fixed scores
  88     my $unchanged_scores = [];
  89     for my $mod (@$mods) {
  90         next if $mod->{id} == $moderation->{id};
  91         my $mms = $self->select(id => $mod->{id});
  92         push @$unchanged_scores, $self->_get_fixed_scores($mod, $mms);
  93     }
  94     my $base_scores = {
  95                       points => sum map { $a->{points} } $unchanged_scores,
  96                       karma => sum map { $a->{karma} } $unchanged_scores,
  97                       };
  98
  99     # calc changed moderation's old score
 100     my $old_score = $self->_get_fixed_scores($moderation, $metamods);
 101     my $old_total = {
 102                      points => floor($base_scores->{points} + $old_score->{points}),
 103                      karma => floor($base_scores->{karma} + $old_score->{karma}),
 104                     };
 105     my $old_result = $self->_get_votes_result($moderation, $metamods);
 106     my $old_moderator_scores = $self->_get_fixed_moderator_scores($moderation, $old_result);
 107
 108     $self->start_transaction;
 109
 110     # create metamod
 111     my $m2id = $self->_create_metamodlog($user, $moderation, $value);
 112     if (!$m2id) {
 113         $self->rollback;
 114         $self->set_error("metamodlog create failed");
 115         return;
 116     }
 117
 118     # calc changed moderation's new score
 119     my $new_metamod = {
 120                        val => $value,
 121                        uid => $user->{uid},
 122                        mmid => $moderation->{id},
 123                        active => 1,
 124                      };
 125     push @$metamods, $new_metamod;
 126     my $new_score = $self->_get_fixed_scores($moderation, $metamods);
 127     my $new_total = {
 128                      points => floor($base_scores->{points} + $new_score->{points}),
 129                      karma => floor($base_scores->{karma} + $new_score->{karma}),
 130                     };
 131     my $delta = {
 132                  points => $new_total->{points} - $old_total->{points},
 133                  karma => $new_total->{karma} - $old_total->{karma},
 134                 };
 135
 136     # update comment's point
 137     my $comments = $self->new_instance_of("Comments");
 138     my $rs = $comments->update(cid => $moderation->{cid},
 139                                points => { add => $delta->{points} });
 140     if (!defined $rs) {
 141         $self->rollback;
 142         $self->set_error("comments update failed");
 143         return;
 144     }
 145
 146     # update comment author's karma
 147     my $users = $self->new_instance_of("Users");
 148     $rs = $users->update_info(uid => $moderation->{cuid},
 149                               karma => { add => $delta->{karma} });
 150     if (!defined $rs) {
 151         $self->rollback;
 152         $self->set_error("users update failed");
 153         return;
 154     }
 155
 156     # update moderator's info
 157     my $new_result = $self->_get_votes_result($moderation, $metamods);
 158     my $new_moderator_scores = $self->_get_fixed_moderator_scores($moderation, $old_result);
 159     my $u_delta = {};
 160     for my $k (qw(karma tokens up_fair down_fair up_unfair down_unfair)) {
 161         $u_delta->{$k} = $old_result->{$k} - $new_result->{$k};
 162     }
 163     $users->update_info(uid => $moderation->{uid},
 164                         tokens => { add => $u_delta->{tokens} },
 165                         up_fair => { add => $u_delta->{up_fair} },
 166                         down_fair => { add => $u_delta->{down_fair} },
 167                         up_unfair => { add => $u_delta->{up_unfair} },
 168                         down_unfair => { add => $u_delta->{down_unfair} });
 169
 170     # update metamoderator's info
 171     my $new_params = {};
 172     $new_params->{m2_fair} = 1 if $value > 0;
 173     $new_params->{m2_unfair} = 1 if $value < 0;
 174     if (($value > 0) && ($moderation->{val} > 0)) {
 175         $new_params->{m2voted_up_fair} = 1;
 176     }
 177     if (($value > 0) && ($moderation->{val} < 0)) {
 178         $new_params->{m2voted_down_fair} = 1;
 179     }
 180     if (($value < 0) && ($moderation->{val} > 0)) {
 181         $new_params->{m2voted_up_unfair} = 1;
 182     }
 183     if (($value < 0) && ($moderation->{val} < 0)) {
 184         $new_params->{m2voted_down_unfair} = 1;
 185     }
 186     $users->update_info(uid => $user->{uid}, %$new_params);
 187
 188     $self->commit;
 189     return $m2id;
 190 }
 191
 192 sub _get_fixed_moderator_scores {
 193     my ($self, $mod, $result) = @_;
 194     my $rs = {
 195               karma => 0,
 196               tokens => 0,
 197               up_fair => 0,
 198               down_fair => 0,
 199               up_unfair => 0,
 200               down_unfair => 0,
 201              };
 202
 203     return $rs if $result->{result} == 0;
 204
 205     my $max_ratio = 0;
 206     my $p;
 207     my $votes = $result->{votes};
 208
 209     if ($result->{result} == 1) {
 210         $p = $m2_params->{token_fair_params};
 211     }
 212     elsif ($result->{result} == -1) {
 213         $p = $m2_params->{token_unfair_params};
 214     }
 215
 216     if ($p) {
 217         if ($votes <= $p->{min_count}) {
 218             $max_ratio = $p->{min};
 219         }
 220         elsif ($votes >= $p->{max_count}) {
 221             $max_ratio = $p->{max};
 222         }
 223         else {
 224             $max_ratio =
 225               log(($votes - $p->{min_count}) * $p->{alpha})/log(10) * $p->{beta} + $p->{min};
 226         }
 227     }
 228     $rs->{tokens} = $result->{result} * $max_ratio * $result->{ratio};
 229
 230     if ($result->{result} == 1) {
 231         $rs->{karma} = 0.5;
 232         $rs->{up_fair} = 1 if $mod->{val} > 0;
 233         $rs->{down_fair} = 1 if $mod->{val} < 0;
 234     }
 235     elsif ($result->{result} == -1) {
 236         $rs->{karma} = -1;
 237         $rs->{up_unfair} = 1 if $mod->{val} > 0;
 238         $rs->{down_unfair} = 1 if $mod->{val} < 0;
 239     }
 240     return $rs;
 241 }
 242
 243 sub _get_fixed_scores {
 244     my ($self, $mod, $metamods) = @_;
 245     return if !defined $mod;
 246     my $rs = {
 247               points => 0,
 248               karma => 0,
 249              };
 250     return $rs if !$mod->{active};
 251     return $rs if !defined $metamods;
 252
 253     my $affect = $self->_get_votes_result($mod, $metamods);
 254
 255     if ($affect->{result} > 0) {
 256         # nod
 257         $rs->{points} = $mod->{val} * (1.0 + $affect->{enforce});
 258         $rs->{karma} = $mod->{val} * (1.0 + $affect->{enforce});
 259     }
 260     elsif ($affect->{result} < 0) {
 261         # nix
 262         $rs->{points} = $mod->{val} * (1.0 - $affect->{prevent});
 263         $rs->{karma} = $mod->{val} * (1.0 - $affect->{prevent});
 264     }
 265     else {
 266         # no agreement
 267         $rs->{points} = $mod->{val};
 268         $rs->{karma} = $mod->{val};
 269     }
 270     return $rs;
 271 }
 272
 273 sub _get_votes_result {
 274     my ($self, $mod, $metamods) = @_;
 275     my $count = @$metamods;
 276     my $rs = {
 277               result => 0,
 278               ratio => 0,
 279               enforce => 0,
 280               prevent => 0,
 281               votes => $count,
 282              };
 283     if ($count < $m2_params->{count_threshold}) {
 284         return $rs;
 285     }
 286
 287     my $nods = grep { $_->{val} == 1 && $_->{active} } @$metamods;
 288     my $nixes = grep { $_->{val} == -1 && $_->{active} } @$metamods;
 289
 290     my $fraction = $nods / $count;
 291     if ($fraction > $m2_params->{agreement_threshold_ratio}) {
 292         $rs->{result} = 1;
 293         $rs->{ratio} = $fraction;
 294     }
 295     else {
 296         $fraction = $nixes / $count;
 297         if ($fraction > $m2_params->{agreement_threshold_ratio}) {
 298             $rs->{result} = -1;
 299             $rs->{ratio} = $fraction;
 300         }
 301     }
 302
 303     if ($rs->{result} == 0) {
 304         # no agreement
 305         return $rs;
 306     }
 307     elsif ($rs->{result} < 0) {
 308         # agreement is nix
 309         $rs->{prevent} =
 310           $self->_calc_ratio($m2_params->{prevent_params}, $count, $fraction);
 311     }
 312     elsif ($rs->{result} > 0) {
 313         # agreement is nod
 314         $rs->{enforce} =
 315           $self->_calc_ratio($m2_params->{enfoce_params}, $count, $fraction);
 316     }
 317     return $rs;
 318
 319 }
 320
 321 sub _calc_ratio {
 322     my ($self, $p, $votes, $agreement_ratio) = @_;
 323     my $max_prevent_ratio;
 324     if ($votes <= $p->{min_count}) {
 325         $max_prevent_ratio = $p->{min};
 326     }
 327     elsif ($votes >= $p->{max_count}) {
 328         $max_prevent_ratio = $p->{max};
 329     }
 330     else {
 331         $max_prevent_ratio =
 332           log(($votes - $p->{min_count}) * $p->{alpha})/log(10) * $p->{beta} + $p->{min};
 333     }
 334     return $max_prevent_ratio - $p->{reduction} * (1.0 - $agreement_ratio);
 335 }
 336
 337 sub select {
 338     my $self = shift;
 339     my $params = {@_};
 340     my $rs;
 341
 342     if ($params->{cid}) {
 343         $rs = $self->select_by_cid(%$params);
 344     }
 345
 346     elsif ($params->{moderation_id}) {
 347         $params->{mmid} = $params->{moderation_id};
 348         my $uniques = [qw(id)];
 349         my $keys = [qw(uid val mmid)];
 350         $rs = $self->generic_select("metamodlog",
 351                                    uniques => $uniques,
 352                                    keys => $keys,
 353                                    params => $params);
 354     }
 355     return $rs;
 356 }
 357
 358 sub select_by_cid {
 359     my $self = shift;
 360     my $params = {@_};
 361     my $cid = $params->{cid};
 362     return if !$cid;
 363
 364     my $moderations = $self->new_instance_of('Moderations');
 365     my $sql = <<"EOSQL";
 366 SELECT metamodlog.*, moderatorlog.cid FROM moderatorlog
 367   RIGHT JOIN metamodlog ON moderatorlog.id = metamodlog.mmid
 368   WHERE moderatorlog.cid = ? AND metamodlog.active = 1;
 369 EOSQL
 370     my $dbh = $self->connect_db;
 371     my $sth = $dbh->prepare($sql);
 372     $sth->execute($cid);
 373     my $rs = $sth->fetchall_arrayref({});
 374     $self->disconnect_db;
 375     return $rs;
 376 }
 377
 378 sub _create_metamodlog {
 379     my ($self, $user, $moderation, $value) = @_;
 380     return if $self->check_readonly;
 381     my $dbh = $self->connect_db;
 382     my $sql = <<"EOSQL";
 383 INSERT INTO metamodlog
 384     (mmid, uid, val, ts, active)
 385   VALUES
 386     (?,    ?,   ?,   NOW(), 1)
 387 EOSQL
 388
 389     my $rs = $dbh->do($sql, undef, $moderation->{id}, $user->{uid}, $value);
 390     if (!$rs) {
 391         $self->disconnect_db;
 392         return;
 393     }
 394     my $m2id = $dbh->last_insert_id(undef, undef, undef, undef);
 395     $self->disconnect_db;
 396     return $m2id;
 397 }
 398
 399
 400
 401 # import from ::Metamod
 402 sub getM2Needed {
 403     my ($self, $user, $comment, $reason, $adjust) = @_;
 404     $adjust ||= 0;
 405
 406     my $mod = $self->getModForM2Inherit($user, $comment, $reason);
 407     my $m2base = $mod ? $mod->{m2needed} : $m2_params->{m2_consensus};
 408     my $m2needed = $m2base + $adjust;
 409     $m2needed++ if !($m2needed % 2); # m2needed always odd value
 410
 411     return $m2needed;
 412 }
 413
 414
 415 # import from ::Metamod
 416 sub getModForM2Inherit {
 417     my ($self, $user, $comment, $reason, $mod_id) = @_;
 418
 419     my $moderations = $self->new_instance_of("Moderations");
 420     my $reasons = $moderations->reasons;
 421     my @m2able_reasons = sort grep { $reasons->{$_}->{m2able} } (keys %$reasons);
 422     return if !@m2able_reasons;
 423
 424     my $m2able = join(", ", @m2able_reasons);
 425     my @params = ( $comment->{cid},
 426                    $reason->{id},
 427                    $user->{uid},
 428                    $comment->{cuid} );
 429     my $id_clause = "";
 430     if ($mod_id) {
 431         $id_clause = " AND id != ?";
 432         push @params, $mod_id;
 433     }
 434
 435     my $sql = <<"EOSQL";
 436 SELECT * FROM moderatorlog
 437   WHERE cid = ?
 438     AND reason = ?
 439     AND uid != ?
 440     AND cuid != ?
 441     AND reason in ($m2able)
 442     AND active = 1 $id_clause
 443   ORDER BY id ASC LIMIT 1
 444 EOSQL
 445     my $dbh = $self->connect_db;
 446     my $sth = $dbh->prepare($sql);
 447     $sth->execute(@params);
 448     my $rs = $sth->fetchrow_hashref;
 449     $self->disconnect_db;
 450
 451     return $rs;
 452 }
 453
 454 sub getInheritedM2sForMod {
 455     my ($self, $user, $comment, $reason, $active, $mod_id) = @_;
 456     return if !$active;
 457
 458     my $mod = $self->getModForM2Inherit($user, $comment, $reason, $mod_id);
 459     my $p_mid = defined $mod ? $mod->{id} : undef;
 460     return if !$p_mid;
 461
 462     my $sql = "SELECT * FROM metamodlog WHERE mmid = ?";
 463     my $dbh = $self->connect_db;
 464     my $sth = $dbh->prepare($sql);
 465     $sth->execute($p_mid);
 466     my $m2s = $sth->fetchall_arrayref({});
 467     if (!$m2s) {
 468         return;
 469     }
 470     $self->disconnect_db;
 471
 472     return $m2s;
 473 }
 474
 475 sub applyInheritedM2s {
 476     my ($self, $mod_id, $m2s) = @_;
 477     my $users = $self->new_instance_of("Users");
 478     for my $m2 (@$m2s) {
 479         my $user = $users->select(uid => $m2->{uid});
 480         my $m2 = { is_fair => $m2->{val} == 1 ? 1 : 0 };
 481         $self->createInherited($mod_id, $m2, $user);
 482     }
 483 }
 484
 485 # createMetaMod with inherited = 1 and multi_max = 0
 486 sub createInherited {
 487     my ($self, $mod_id, $m2, $user) = @_;
 488     return if $self->check_readonly;
 489     my $mods = $self->new_instance_of("Moderations");
 490
 491     # We need to know whether the M1 IDs are for moderations
 492     # that were up or down.
 493     #my $m1_list = join(",", keys %$m2s);
 494     #my $m2s_vals = $self->sqlSelectAllHashref("id", "id, val",
 495     #                                          "moderatorlog", "id IN ($m1_list)");
 496     #for my $m1id (keys %$m2s_vals) {
 497     #    $m2s->{$m1id}{val} = $m2s_vals->{$m1id}{val};
 498     #}
 499     my $mod = $mods->select(id => $mod_id);
 500     return if !$mod;
 501     $m2->{val} = $mod->{val};
 502
 503     # Whatever happens below, as soon as we get here, this user has
 504     # done their M2 for the day and gets their list of OK mods cleared.
 505     # The only exceptions are admins who didn't metamod any of their
 506     # saved mods, and inherited M2s.  In the case of inherited mods
 507     # the m2_user isn't actively m2ing, their m2s are just being
 508     # applied to another mod.
 509
 510     my $voted_up_fair = 0;
 511     my $voted_down_fair = 0;
 512     my $voted_up_unfair = 0;
 513     my $voted_down_unfair = 0;
 514
 515     my $mod_uid = $mod->{uid};
 516     my $is_fair = $m2->{is_fair};
 517
 518     my $rows = 0;
 519     if ($user->{is_admin}
 520         || $user->{tokens} >= $m2_params->{m2_mintokens}) {
 521
 522         my $sql = <<"EOSQL";
 523 UPDATE moderatorlog
 524   SET m2count = ?,
 525       m2status = IF(m2count >= m2needed AND MOD(m2count, 2) = 1, 1, 0)
 526   WHERE id = ?
 527     AND m2status = 0
 528     AND m2count < m2needed
 529     AND active=1
 530 EOSQL
 531         my $dbh = $self->connect_db;
 532         my $rs = $dbh->do($sql, undef, $mod_id);
 533         $rows += $rs || 0; # if no error, returns 0E0 (true!), we want a numeric answer
 534         $self->disconnect_db;
 535     }
 536
 537     my $users = $self->new_instance_of("Users");
 538     if ($is_fair  && $m2->{val} > 0) {
 539         ++$voted_up_fair;
 540         #$users->update("info", field => "up_fair", add => 1, uid => $mod_uid);
 541         $users->update_info(uid => $mod_uid, up_fair => {add => 1});
 542         #$ui_hr->{-up_fair}      = "up_fair+1";
 543     } elsif ($is_fair  && $m2->{val} < 0) {
 544         ++$voted_down_fair;
 545         #$users->update("info", field => "down_fair", add => 1, uid => $mod_uid);
 546         $users->update_info(uid => $mod_uid, down_fair => {add => 1});
 547         #$ui_hr->{-down_fair}    = "down_fair+1";
 548     } elsif (!$is_fair && $m2->{val} > 0) {
 549         ++$voted_up_unfair;
 550         #$users->update("info", field => "up_unfair", add => 1, uid => $mod_uid);
 551         $users->update_info(uid => $mod_uid, up_unfair => {add => 1});
 552         #$ui_hr->{-up_unfair}    = "up_unfair+1";
 553     } elsif (!$is_fair && $m2->{val} < 0) {
 554         ++$voted_down_unfair;
 555         #$users->update("info", field => "down_unfair", add => 1, uid => $mod_uid);
 556         $users->update_info(uid => $mod_uid, down_unfair => {add => 1});
 557         #$ui_hr->{-down_unfair}  = "down_unfair+1";
 558     }
 559
 560     my $active;
 561     if ($rows) {
 562         # If a row was successfully updated, insert a row
 563         # into metamodlog.
 564         $active = 1;
 565     } else {
 566         # If a row was not successfully updated, probably the
 567         # moderation in question was assigned to more than
 568         # $consensus users, and the other users pushed it up to
 569         # the $consensus limit already.  Or this user has
 570         # gotten bad M2 and has negative tokens.  Or the mod is
 571         # no longer active.
 572         $active = 0;
 573     }
 574     my $sql = <<"EOSQL";
 575 INSERT INTO metamodlog
 576     (mmid, uid, val, ts,    active)
 577   VALUES
 578     (?,    ?,   ?,   NOW(), ?)
 579 EOSQL
 580     my $dbh = $self->connect_db;
 581     my $rs = $dbh->do($sql, undef,
 582                       $mod_id, $user->{uid}, ($is_fair ? '+1' : '-1'), $active);
 583     if (!$rs) {
 584         return;
 585     }
 586     $self->disconnect_db;
 587
 588     $users->update_info(uid => $mod_uid,
 589                         m2voted_up_fair => {add => $voted_up_fair},
 590                         m2voted_down_fair => {add => $voted_down_fair},
 591                         m2voted_up_unfair => {add => $voted_up_unfair},
 592                         m2voted_down_unfair => {add => $voted_down_unfair}
 593                        );
 594     return 1;
 595 }
 596
 597 sub adjustForNewMod {
 598     my ($self, $user, $comment, $reason, $active, $mod_id) = @_;
 599     my $i_m2s = $self->getInheritedM2sForMod($user, $comment, $reason, $active, $mod_id);
 600     $self->applyInheritedM2s($mod_id, $i_m2s);
 601 }