User:FACBot/far.pl

#!/usr/bin/perl -w
#
# far.pl -- Pass or fail an Featured Article class review
#     This Bot runs every day, looking for featured class articles that have been processed by a delegate
#    If it finds one, it follows the steps involved in keeping or delisting it.
# Usage: far.pl
#    13 February 15 Created

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

use Carp;
use Data::Dumper;
use File::Basename qw(dirname);
use File::Spec;
use MediaWiki::Bot;
use POSIX qw(strftime);
use XML::Simple;

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

# Pages used
my $candidates_page = 'Wikipedia:featured article review';
my $showcase_fa = 'Wikipedia:WikiProject Military history/Showcase/FA';

my $editor = MediaWiki::Bot->new ({
        assert        => 'bot',
        host        => 'en.wikipedia.org',
        protocol     => 'https',
}) or die "new MediaWiki::Bot failed";

my $dirname = dirname (__FILE__, '.pl');
push @INC, $dirname;
require Cred;
my $cred = new Cred ();
my $log = $cred->log ();

require showcase;

sub allow_bots ($$;$) {
    my($text, $user, $opt) = @ARG;
    return 0 if $text =~ /{{[nN]obots}}/;
    return 1 if $text =~ /{{[bB]ots}}/;
    if ($text =~ /{{[bB]ots\s*\|\s*allow\s*=\s*(.*?)\s*}}/s){
        return 1 if $1 eq 'all';
        return 0 if $1 eq 'none';
        my @bots = split(/\s*,\s*/, $1);
        return (grep $ARG eq $user, @bots)?1:0;
    }
    if ($text =~ /{{[bB]ots\s*\|\s*deny\s*=\s*(.*?)\s*}}/s){
        return 0 if $1 eq 'all';
        return 1 if $1 eq 'none';
        my @bots = split(/\s*,\s*/, $1);
        return (grep $ARG eq $user, @bots)?0:1;
    }
    if (defined($opt) && $text =~ /{{[bB]ots\s*\|\s*optout\s*=\s*(.*?)\s*}}/s){
        return 0 if $1 eq 'all';
        my @opt = split(/\s*,\s*/, $1);
        return (grep $ARG eq $opt, @opt)?0:1;
    }
    return 1;
}

sub error_exit ($) {
    my @message = @ARG;
    if ($editor->{error}->{code}) {
        push @message, ' (', $editor->{error}->{code} , ') : ' , $editor->{error}->{details};
    }
    $cred->error (@message);
}

sub has_been_closed ($) {
    my ($nomination) = @ARG;
    $cred->showtime ("checking if $nomination has been closed...\n");
    my $text = $editor->get_text ($nomination) or
        error_exit ("Unable to find '$nomination')");
    if ($text =~ /{{FARClosed\|(.+?)}}.+(\d+:\d+, \d+ (\w+) (\d+) \(UTC\))/) {
        $cred->showtime ("\t$nomination $1\n");
        return ($1, $2, $3, $4);
    }
    return ();
}   

sub whodunnit ($$$) {
    my ($article, $nomination, $action) = @ARG;
    my $old;
    my @history = $editor->get_history ($nomination) or
        error_exit ("Unable to get history of '$nomination'");
    foreach my $revision (@history) {
#        print Dumper $revision, "\n";
        my $text = $editor->get_text ($nomination, $revision->{revid}) or
            error_exit ("Unable to find '$nomination:$revision->{revid}')");
        if ($text !~ /{{FARClosed/) {
            $cred->showtime ("\t$article was $action by $old->{user} at $old->{timestamp_date} $old->{timestamp_time}\n");
            my $diff = "https://en.wikipedia.org/w/index.php?title=$nomination\&diff=$old->{revid}\&oldid=$revision->{revid}";
            $diff =~ s/ /_/g;
#            print $diff, "\n";
            return ($old->{user}, $old->{timestamp_date}, $old->{timestamp_time}, $diff);
        } else {
            $old = $revision;
        }
    }
}

sub keep_update_nomination_page ($$$$$) {
    my ($page, $nomination, $user, $date, $diff) = @ARG;
    $cred->showtime ("\tUpdating the nomination page\n");
    my $text = $editor->get_text ($nomination) or
        error_exit ("Unable to find '$nomination')");
    $cred->error ("no bots allowed on '$nomination'") unless allow_bots ($text, $cred->user);

    # Remove transcluded article links and featured article tools
    $text =~ s/<noinclude>.+<\/noinclude>//s;

    # Tag the top and bottom of the page
    my $result = "'''kept''' by [[User:$user|$user]] via ~~~ $date [$diff]";
    my $top = "{{subst:FAR top|result=$result}}";
    my $bottom = "{{subst:FAR bottom}}\n";
    $text = join "\n", $top, $text, $bottom;

    $editor->edit ({
        page => $nomination,
        text => $text,
        summary => "'$page' kept",
        bot => 1,
        minor => 0,
    }) or
        error_exit ("unable to edit '$nomination'");
}

sub delist_update_nomination_page ($$$$$) {
    my ($page, $nomination, $user, $date, $diff) = @ARG;
    $cred->showtime ("\tUpdating the nomination page\n");
    my $text = $editor->get_text ($nomination) or
        error_exit ("Unable to find '$nomination')");
    $cred->error ("no bots allowed on '$nomination'") unless allow_bots ($text, $cred->user);

    # Remove transcluded article links and featured article tools
    $text =~ s/<noinclude>.+<\/noinclude>//s;

    # Tag the top and bottom of the page
    my $result = "'''delisted''' by [[User:$user|$user]] via ~~~ $date [$diff]";
    my $top = "{{subst:FAR top|result=$result}}";
    my $bottom = "{{subst:FAR bottom}}\n";
    $text = join "\n", $top, $text, $bottom;

    $editor->edit ({
        page => $nomination,
        text => $text,
        summary => "Archiving '$page'",
        bot => 1,
        minor => 0,
    }) or
        error_exit ("unable to edit '$nomination'");
}

sub delist_update_article_page ($) {
    my ($page) = @ARG;
    $cred->showtime ("\tUpdating the article page\n");
    my $text = $editor->get_text ($page) or
        error_exit ("Unable to find '$page')");
    $cred->error ("no bots allowed on '$page'") unless allow_bots ($text, $cred->user);

    $text =~ s/{{featured article}}//igs;

    $editor->edit ({
        page => $page,
        text => $text,
        summary => "Delisting '$page' after unsuccessful Featured Article Review",
        bot => 1,
        minor => 0,
    }) or
        error_exit ("unable to edit '$page'");
}

sub parse_template ($@) {
    my ($text, @args) = @ARG;
    my %p;
    while ($text =~ s/\|(\w+)\s*=\s*([^}|]+)//is) {
        $p{$1}=$2;   
    }
   
    my @p = split '\|', $text;
    param:foreach my $p (@p) {
        next param unless $p;
        foreach my $arg (@args) {
            if (!defined $p{$arg}) {
                $p{$arg} = $p;
                next param;
            }
        }
    }
#    foreach my $p (keys %p) {
#        print "$p => $p{$p}\n";
#    }
   
    return %p;
}

sub newaction ($$$$$$) {
    my ($action, $date, $link, $result, $revid, $id) = @ARG;
    my $newaction = join "\n",
        "|action${id}=$action",
        "|action${id}date=$date",
        "|action${id}link=$link",
        "|action${id}result=$result",
        "|action${id}oldid=$revid";
    return $newaction;
}

sub update_article_history ($$$$$$) {
    my ($text, $action, $date, $link, $result, $revid) = @ARG;
    $text =~ s/{{Article\s*History/{{ArticleHistory/is;
    my ($articleHistory) = $text =~ /{{ArticleHistory(.+?)}}/gis;
    if ($articleHistory) {
#        print "articlehistory='$articleHistory'\n";
        for (my $id = 1;; ++$id) {
            if ($articleHistory =~ /action$id/) {
#                print "\t\tfound action$id\n";
            } else {
#                print "\t\tno $id - going with that\n";
                my $newaction = newaction ($action, $date, $link, $result,  $revid, $id);
                $text =~ s/{{Article\s*History(.+?)}}/{{ArticleHistory$1\n$newaction\n}}/is;
                last;
            }
        }
    } else {
        my $newaction = newaction ($action, $date, $link, $result, $revid, 1);
        $text =~ s/^/{{ArticleHistory\n$newaction\n}}\n/is;
    }
    return $text;
}

sub get_revid ($$$) {
    my ($page, $date, $time) = @ARG;
    my @history = $editor->get_history ($page) or
        error_exit ("Unable to get history of '$page'");
    foreach my $history (@history) {
        if ($history->{timestamp_date} le $date ||
                ($history->{timestamp_date} eq $date && $history->{timestamp_time} le $time)) {   
            return $history->{revid};
        }
    }
    error_exit ("Unable to get revid of '$page')");
}

sub keep_update_talk_page ($$$$$) {
    my ($page, $talk, $nomination_page, $date, $time) = @ARG;
   
    $cred->showtime ("\tUpdating the talk page\n");
    my $text = $editor->get_text ($talk) or
        error_exit ("Unable to find '$talk')");
    $cred->error ("no bots allowed on '$talk'") unless allow_bots ($text, $cred->user);

    # Remove the candidacy
    $text =~ s/{{featured article review\|.+?}}//;

    # Update the article history
    my $revid = get_revid ($page, $date, $time);
    $text = update_article_history ($text, 'FAR', $date, $nomination_page, 'kept', $revid);

    $editor->edit ({
        page => $talk,
        text => $text,
        summary => "Updating '$page' after successful Featured Article Review",
        bot => 1,
        minor => 0,
    }) or
        error_exit ("unable to edit '$talk'");
}

sub delist_update_talk_page ($$$$$) {
    my ($page, $talk, $nomination_page, $date, $time) = @ARG;
   
    $cred->showtime ("\tUpdating the talk page\n");
    my $text = $editor->get_text ($talk) or
        error_exit ("Unable to find '$talk')");
    $cred->error ("no bots allowed on '$talk'") unless allow_bots ($text, $cred->user);

    # Remove the candidacy
    $text =~ s/{{featured article review\|.+?}}//;

    # Update the article history
    my $revid = get_revid ($page, $date, $time);
    $text = update_article_history ($text, 'FAR', $date, $nomination_page, 'demoted', $revid);
   
    # Update the current status
    $text =~ s/currentstatus=FA/currentstatus=FFA/is;
    $text =~ s/class=FA/class=/igs;

    $editor->edit ({
        page => $talk,
        text => $text,
        summary => "Updating '$page' after unsuccessful Featured Article Review",
        bot => 1,
        minor => 0,
    }) or
        error_exit ("unable to edit '$talk'");
}

sub remove_from_showcase ($) {
    my ($article) = @ARG;
       
    my $showcase_text = $editor->get_text ($showcase_fa) or
        error_exit ("Unable to find '$showcase_fa'");
    $cred->error ("no bots allowed on '$showcase_fa'") unless allow_bots ($showcase_text, $cred->user);

    my $showcase = new showcase ($showcase_text);
    my $found = $showcase->del ($article);

    if ($found) {   
        $editor->edit ({
            page => $showcase_fa,
            text => $showcase->text,
            summary => "'$article' has been delisted",
#            bot => 1,
            minor => 0,
        }) or
            error_exit ("unable to edit '$showcase_fa'");
    }
    return $found;
}

# Find the nomination page
sub nomination ($) {
    my ($talk) = @ARG;
    my $text = $editor->get_text ($talk) or
        error_exit ("Unable to find '$talk')");
    $text =~ /{{featured article review\|(.+?\/archive\d+)}}/;
    my $nomination = "Wikipedia:Featured article review/$1";
    $nomination =~ s/&#([0-9a-f]+);/chr($1)/ige;
    $cred->showtime ("\t$nomination\n");
    return $nomination;
}

$editor->login ({
    username => $cred->user,
    password => $cred->password
}) or die $editor->{error}->{code} . ': ' . $editor->{error}->{details};

$cred->showtime ("========== Commenced ==========\n");

# First, we need to find the nomination pages
my @candidates = $editor->get_pages_in_category ('Wikipedia featured article review candidates');
foreach my $talk (@candidates) {

    my $article = $talk;
    $article =~ s/Talk:// or
        next;
    $cred->showtime ($article, "\n");

    my $nomination = nomination ($talk);
    if (my ($status, $display_date, $month, $year) = has_been_closed ($nomination)) {
        $cred->showtime ("\t$nomination closed ($status) on $display_date\n");
        if ($status =~ /kept|keep/i) {
            my ($user, $date, $time, $diff) = whodunnit ($article, $nomination, 'kept');
            keep_update_talk_page ($article, $talk, $nomination, $date, $time);
            keep_update_nomination_page ($article, $nomination, $user, $display_date, $diff);
        } elsif ($status =~ /delisted/i) {
            my ($user, $date, $time, $diff) = whodunnit ($article, $nomination, 'delisted');
            delist_update_talk_page ($article, $talk, $nomination, $date, $time);
            delist_update_nomination_page ($article, $nomination, $user, $display_date, $diff);
            delist_update_article_page ($article);
            remove_from_showcase ($article);
        } else {
            $cred->showtime ("\tunknown status\n");
        }       
    } else {
        $cred->showtime ("\t$nomination is still current\n");
    }
}
exit 0;