#!/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;
