User:MilHistBot/reviews.pl

#!/usr/bin/perl -w
# reviews.pl -- Count reviews per user
# Usage: reviews.pl
#    18 Oct 18 Created

use English;
use strict;
use utf8;
use warnings;

use DateTime;
use Data::Dumper;

use Cred;
use MilHist::Bot;
use MilHist::Parser;
use MilHist::Table;
use MilHist::Template;

binmode (STDERR, ':utf8');
binmode (STDOUT, ':utf8');

my $cred = new Cred ();
my $editor = MilHist::Bot->new ($cred) or
  die "new MediaWiki::Bot failed";

sub bold ($) {
    return "'''" . $ARG[0] . "'''";
}

sub dates () {
    my $today = DateTime->now ();
    my $last_of_month = $today->clone ();
    $last_of_month->subtract ('months' => 1) until $last_of_month->month % 3 == 1;
    $last_of_month = $last_of_month->subtract (days => $today->day ());
    my $first_of_month = DateTime->new ('day' => 1, 'month' => $last_of_month->month (), 'year' => $last_of_month->year ())->subtract ('months' => 2);   
    my $start = $first_of_month->strftime ("%Y-%m-%d");
    my $end = $last_of_month->strftime ("%Y-%m-%d");
    my $display_start = $first_of_month->strftime ("%B");
    my $display_end = $last_of_month->strftime ("%B %Y");
    return ($start, $end, $display_start, $display_end);
}

sub list_to_hash ($) {
    my ($list) = @ARG;
    my %a = $list =~ /\[\[(.+?)\|(.+?)\]\]/g;
    return %a;
}

sub aclass_nominators ($) {
    my ($assessment) = @ARG;
    my $nom_text = $editor->fetch ($assessment);

    my @nm = ($nom_text =~ /<small>''Nominator\(s\):(.+)/ig);
    my @nominators = ($nm[0] =~ /\[\[User:(.+?)\|/gi);

    @nominators or
        @nominators = $nm[0] =~ /{{u\|(.+?)}}/gi;

    @nominators or
        @nominators = $nm[0] =~ /{{user0\|(.+?)}}/gi;

    @nominators or
        $editor->error ("Unable to find nominator of '$assessment'");

    return @nominators;
}

sub nominators ($$) {
   my ($type, $review) = @ARG;
    
    my @nominators;
    if ($type eq 'ACR' || $type eq 'FAC') {
        @nominators = aclass_nominators ($review);                    
    } elsif ($type eq 'PR') {
        my $nominator = creator ($review);
        @nominators = $nominator ? ($nominator) : ();
#       print "\tnominator='$nominator'\n";         
    } else {
        $cred->warning ("unknown review type ($type) -- skipping\n");
    }
#   foreach my $nominator (@nominators) {
#       print "\tnominator='$nominator'\n";
#   }
    my %nominators = map { $ARG => 1 } @nominators;
    return %nominators;
}

sub creator ($) {
    my ($review) = @ARG;  
    my @history = $editor->get_history ($review);
    # Review may not be started yet
    return undef unless @history;
    my $history = pop @history;
    my $creator = $history->{'user'};
    return $creator;       
}

sub ga_reviews ($$$$) {
    my ($type, $start, $end, $hash) = @ARG;
    my $reviews = {};
    foreach my $review (keys %$hash) {
        my $reviewer = creator ($review);
        next unless $reviewer;
        ++$reviews->{$reviewer};
        $cred->showtime ("$type: '$review' reviewed by '$reviewer' ($reviews->{$reviewer})\n");
    }
    return $reviews;       
}

sub reviews ($$$$) {
    my ($type, $start, $end, $hash) = @ARG;
    my $reviews = {};
    foreach my $review (keys %$hash) {        
        my %nominators = nominators ($type, $review);
        my %reviewers;
        # Zero is possible, as the review page may not have been created yet
        my @history = $editor->get_history ($review);
#       print "revisions = ", scalar @history, "\n";
        foreach my $history (@history) {
            my $date = $history->{timestamp_date};
            next if $date gt $end;
            last if $date lt $start;
            my $reviewer = $history->{'user'};
            next if $nominators{$reviewer};
            $reviewers{$reviewer} = 1;
        }
        foreach my $reviewer (keys %reviewers) {
            ++$reviews->{$reviewer};
            $cred->showtime ("$type: '$review' reviewed by '$reviewer' ($reviews->{$reviewer})\n");
        }        
    }
    return $reviews;       
}

sub tally ($$$) {
    my ($reviews, $type, $tally) = @ARG;
    foreach my $reviewer (keys %$tally) {
        $reviews->{$reviewer} //= {};
        $reviews->{$reviewer}->{$type} = $tally->{$reviewer};
    }    
}

sub award ($) {
    my ($tally) = @ARG;    
    my $award = ($tally >= 15) ? 'WikiChevrons' :
                ($tally >= 8)  ? 'The Content Review Medal of Merit (Military history)' :
                ($tally >= 4)  ? 'The Milhist reviewing award (2 stripes)' :
                                 'The Milhist reviewing award (1 stripe)';
    return $award;
}

sub nomination ($$$$) {
    my ($reviewer, $tally, $display_start, $display_end) = @ARG;    
    my $nomination = new MilHist::Template ('name' => "WPMILHIST Award nomination");
    $nomination->add ('nominee'  => $reviewer);
    $nomination->add ('citation' => "for $display_start to $display_end reviews");
    $nomination->add ('award'    => award ($tally));
    $nomination->add ('status'   => 'nominated');    
    my $text = $nomination->text ();
    return $text;
}

sub report ($$$) {
    my ($reviews, $display_start, $display_end) = @ARG;
    my $heading = ['User', 'FA', 'A-Class', 'GA', 'PR', 'Total', 'Nomination'];
    my @rows;
    
    my ($fac_total, $acr_total, $ga_total, $pr_total);
    foreach my $reviewer (keys %$reviews) {
        my $fac = $reviews->{$reviewer}->{'FAC'};        
        my $acr = $reviews->{$reviewer}->{'ACR'};
        my $ga = $reviews->{$reviewer}->{'GA'};
        my $pr = $reviews->{$reviewer}->{'PR'};
        my $total = ($fac // 0) + ($acr // 0) + ($ga // 0) + ($pr // 0);

        $fac_total += $fac // 0;
        $acr_total += $acr // 0;
        $ga_total  += $ga  // 0;
        $pr_total  += $pr  // 0;

        my $nomination = nomination ($reviewer, $total, $display_start, $display_end);
        my $row = [bold ($reviewer) => $fac // '', $acr // '', $ga // '', $pr // '', $total, $nomination];
        push @rows, $row;        
    }
    my $grand_total = $fac_total + $acr_total + $ga_total + $pr_total;
    my $row = [bold ('total') => bold ($fac_total), bold ($acr_total), bold ($ga_total), bold ($pr_total), bold ($grand_total), ''];
    push @rows, $row;        
       
    my $table = new MilHist::Table ();
    $table->options ({'align' => ['left', 'right', 'right', 'right', 'right', 'right', ]});
    my $text = $table->tabulate ($heading, \@rows);
#    print $text;
    return $text;     
}

sub post_report ($$$) {
    my ($report, $display_start, $display_end) = @ARG;
    
    my $coordination_page = 'Wikipedia Talk:WikiProject_Military_history/Coordinators';

    my $text = $editor->fetch ($coordination_page);
    
    $text .= join '',   "\n",
                        "==$display_start to $display_end reviewing tallies==\n",
                        $report,
                        "\n",
                        "~~~~\n";

     $cred->showtime ("Adding report to $coordination_page\n");                
    $editor->edit ({
        page => $coordination_page,
        text => $text,
        summary => "$display_start to $display_end reviewing tallies",
        minor => 0,
    }) or
        $editor->error ("unable to edit '$coordination_page'");        
       
}

$cred->showtime ("started\n");    
eval {
   
    my ($start, $end, $display_start, $display_end) = dates ();
    my $announcements = 'Template:WPMILHIST Announcements';
    my @history = $editor->get_history ($announcements) or
        $editor->error ("Unable get history of '$announcements'");
    
    my (%acr, %fac, %pr, %ga);
     $cred->showtime ("Tallying reviews\n");                
    foreach my $history (@history) {
        my $date = $history->{timestamp_date};
        next if $date gt $end;
        last if $date lt $start;

        my $text = $editor->get_text ($announcements, $history->{revid}) or
            $editor->error ("Unable to find '$announcements:$history->{revid}')");
        my $parser = new MilHist::Parser ('text' => $text);
        my $template = $parser->find ('WPMILHIST Announcements/Shell') or
            die "unable to find WPMILHIST Announcements/Shell in $announcements:$history->{revid}";

        my @ga_nominees = $parser->find ('WPMHA/GAN') or
            die "unable to find good_article_nominees parameter";                
        foreach my $nominee (@ga_nominees) {           
            my $candidate = join '', 'Talk:', $nominee->get (1), '/GA', ($nominee->get (2) // 1);
            $ga{$candidate} = 1;
        }

        my $fac_list = $template->get ('featured_article_candidates') or
            die "unable to find featured_article_candidates parameter";
        %fac = (%fac, list_to_hash ($fac_list));        
       
        my $acr_list = $template->get ('A-Class_reviews') or
            die "unable to find A-Class_reviews parameter";
        %acr = (%acr, list_to_hash ($acr_list));        
        
        my $pr_list = $template->get ('peer_reviews') or
            die "unable to find peer_reviews parameter";
        %pr = (%pr, list_to_hash ($pr_list));        

    }
    
     $cred->showtime ("Tallying reviewers\n");                
    my $fac_reviews = reviews ('FAC', $start, $end, \%fac);
    my $acr_reviews = reviews ('ACR', $start, $end, \%acr);
    my $ga_reviews  = ga_reviews ('GA',  $start, $end, \%ga);
    my $pr_reviews  = reviews ('PR',  $start, $end, \%pr);
    
    my $reviews = {};
    tally ($reviews, 'FAC' => $fac_reviews);
    tally ($reviews, 'ACR' => $acr_reviews);
    tally ($reviews, 'GA'  => $ga_reviews);
    tally ($reviews, 'PR'  => $pr_reviews);
    
    my $report = report ($reviews, $display_start, $display_end);
    post_report ($report, $display_start, $display_end);                   
};
if ($EVAL_ERROR) {
    $cred->error ($EVAL_ERROR);
}
$cred->showtime ("finished\n");
exit 0;