User:FACBot/far.pl

{{syntaxhighlight|lang=perl|code=
 * 1) !/usr/bin/perl -w
 * 2) far.pl -- Pass or fail an Featured Article class review
 * 3)     This Bot runs every day, looking for featured class articles that have been processed by a delegate
 * 4)    If it finds one, it follows the steps involved in keeping or delisting it.
 * 5) Usage: far.pl
 * 6)    13 February 15 Created
 * 1)    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');

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

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) { 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;            return ($old->{user}, $old->{timestamp_date}, $old->{timestamp_time}, $diff);        } else {            $old = $revision;        }    } }
 * 1)        print Dumper $revision, "\n";
 * 1)            print $diff, "\n";

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>//s;

# Tag the top and bottom of the page my $result = "kept by $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>//s;

# Tag the top and bottom of the page my $result = "delisted by $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; }       }    }    return %p; }
 * 1)    foreach my $p (keys %p) {
 * 2)        print "$p => $p{$p}\n";
 * 3)    }

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) { for (my $id = 1;; ++$id) { if ($articleHistory =~ /action$id/) { } else { 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; }
 * 1)        print "articlehistory='$articleHistory'\n";
 * 1)                print "\t\tfound action$id\n";
 * 1)                print "\t\tno $id - going with that\n";

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",            minor => 0,        }) or            error_exit ("unable to edit '$showcase_fa'"); }   return $found; }
 * 1)            bot => 1,

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; }
 * 1) Find the nomination page

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

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

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

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; }}