User:MilHistBot/aclass.pl

{{syntaxhighlight|lang=perl|code=
 * 1) !/usr/bin/perl -w
 * 2) aclass.pl -- Pass or fail an A class review
 * 3)     This Bot runs every hour, looking for A class articles that have been promoted by a MilHist administrator
 * 4)    If it finds one, it follows the steps involved in promoting or failing it.
 * 5) Usage: aclass.pl
 * 6)    30 Mar 13 Add failure option
 * 7)     2 Jun 14 Add reassessment options
 * 8)     7 Jun 14 Error handling
 * 9)    14 Aug 14 Change a message
 * 10)     6 Sep 14 Enhancements:
 * 11)        (a) Do not stop if a bad nomination is found
 * 12)        (b) Follow the redirect is the assessment page is a redirect
 * 13)        (c) Mark edits as bot but not minor
 * 14)        (d) Make STDERR a utf8
 * 15)     8 Sep 14 Some templates are listed with underscores instead of spaces
 * 16)        Perform step 4a (removal from nom page) first
 * 17)    22 Jan 16 Do not leave a blank line behind on the review page
 * 18)     9 Nov 16 Patches for nominators in strange format
 * 19)    17 Oct 17 Allow for Coordinators on meta
 * 20)    12 Nov 17 Higher MilHist Awards
 * 21)    20 Nov 17 Higher MilHist Awards
 * 22)    22 Feb 18 MilHist awards script
 * 1)    22 Feb 18 MilHist awards script

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

use Carp qw(croak longmess); use Data::Dumper; use File::Basename; use MediaWiki::Bot; use POSIX; use unicode::collate; use XML::Simple;

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

my $pagename; my $talkpage; my $assessment; my $outcome; my $redirect;

my $aclass_review = 'Wikipedia:WikiProject Military history/Assessment/A-Class review';

my $year; my $month; my $next_month; my $next_year;

my $Collator = Unicode::Collate->new; my $editor = MediaWiki::Bot->new({       assert        => 'bot',        host        => 'en.wikipedia.org',        protocol     => 'https',        operator     => 'Hawekeye7',    }) or die "new MediaWiki::Bot failed"; my $dirname = dirname (__FILE__, '.pl'); push @INC, $dirname; require Cred; my $cred = new Cred ; my $log = $cred->log ;
 * 1) log in to the wiki

require showcase;

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

sub set_date { my @current_time = gmtime ; $year = $current_time[5] + 1900; $month = $current_time[4]; ($next_month, $next_year) = (11 == $month) ? (0, $year+1) : ($month+1, $year); }

sub nominators { my $nom_text = $editor->get_text ($assessment) or       error_exit ("Unable to find '$assessment')");

my @nm = ($nom_text =~ / ''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       error_exit "Unable to find nominator";

return @nominators; }

sub step1 ($$) { $cred->showtime ("Step1: Archiving the nomination page\n"); my ($comment, $summary) = @ARG; my $text = $editor->get_text ($assessment) or       error_exit ("Unable to find '$assessment'");

my $page_text = join "\n", '{{subst:archive top}}', "$comment ~", $text, '{{subst:archive bottom}}';

$editor->edit ({       page => $assessment,        text => $page_text,        summary => $summary,        minor => 0,    }) or        error_exit ("unable to edit '$assessment'");

}

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) { my $has_nested_text; while ($text =~ /{{ArticleHistory[^}]+({{[^}]+}})/) { my $nested_text = $1; my $transformed_text = $nested_text; $transformed_text =~ s/{{(.+)}}/%%<$1>%%/; $text =~ s/\Q$nested_text\E/$transformed_text/; $has_nested_text = 1; }
 * 1)            print "Nested text!!!!\n";
 * 1)            print "nested text=$nested_text\n";
 * 1)            print "transformed text=$transformed_text\n";

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; }       }        if ($has_nested_text) { $text =~ s/%%%%/}}/g; }
 * 1)        print "articlehistory='$articleHistory'\n";
 * 1)                print "\t\tfound action$id\n";
 * 1)                print "\t\tno $id - going with that\n";

} else { my $newaction = newaction ($action, $date, $link, $result, $revid, 1); $text =~ s/^/{{ArticleHistory\n$newaction\n}}\n/is; }   return $text; }

sub step23 ($$) { my ($result, $summary) = @ARG;

$cred->showtime ("Step2: Get the permanent link\n"); my ($history) = $editor->get_history ($pagename, 1) or       error_exit ("Unable to get history of '$pagename'");

my $revision = $history->{revid};

$cred->showtime ("Step3: Update the talk page\n"); my $text = $editor->get_text ($talkpage) or       error_exit ("Unable to find '$talkpage'"); $text = update_article_history ($text, 'WAR', '', $assessment, $result, $revision);
 * 1)    print $text, "\n";

foreach ($text) { if ($outcome eq 'pass') { s/((WikiProject Ships|WPSHIPS|WikiProject Aviation|ShipwrecksWikiProject|WikiProject Military history|WPMILHIST|MILHIST).+?)class=(Start|Stub|B|C|GA)/$1class=A/igs; }       if ($outcome eq 'demoted') { s/((WikiProject Ships|WPSHIPS|WikiProject Aviation|ShipwrecksWikiProject|WikiProject Military history|WPMILHIST|MILHIST).+?)class=A/$1class=C/igs; }       s/A-class=current/A-Class=$outcome/igs; }   $editor->edit ({        page => $talkpage,        text => $text,        summary => $summary,        minor => 0,    }) or        error_exit ("unable to edit '$talkpage'");
 * 1)    print $text, "\n";

}

sub step4a ($) { $cred->showtime ("Step4a: Update the review page\n"); my ($summary) = @ARG;

my $text = $editor->get_text ($aclass_review) or       error_exit ("Unable to find '$aclass_review'");

$text =~ s/WikiProject_Military_history/WikiProject Military history/g; my $p = $redirect // $assessment; $text =~ s/{{\Q$p\E}}\s*\n//s or       error_exit ("Unable to find '$p' on '$aclass_review'"); undef $redirect;
 * 1)    print $text, "\n";
 * 1)    print $text, "\n"; ############

$editor->edit ({       page => $aclass_review,        text => $text,        summary => $summary,        minor => 0,    }) or        error_exit ("Unable to edit '$aclass_review'"); }

sub step4b ($$) { $cred->showtime ("Step4b: Archive the review\n"); my ($result, $summary) = @ARG;

my $archive = "Wikipedia:WikiProject Military history/Assessment/$year"; my $text = $editor->get_text ($archive); $text or do {

$text = join "", "{{WPMILHIST Archive|category=review}}\n", "{{WPMILHIST Navigation}} \n", "== Promoted ==\n", "WikiProject Military history/Assessment/$year/Promoted\n", "\n", "== Failed ==\n", "WikiProject Military history/Assessment/$year/Failed\n", "\n", "== Kept ==\n", "WikiProject Military history/Assessment/$year/Kept\n", "\n", "== Demoted ==\n", "WikiProject Military history/Assessment/$year/Demoted\n", "\n", "\n";

$editor->edit ({           page => $archive,            text => $text,            summary => "Created new archive page for $year",            minor => 0,        }) or            error_exit ("Unable to find '$archive'"); };

$archive = "Wikipedia:WikiProject Military history/Assessment/$year/$result"; $text = $editor->get_text ($archive); $text or do {

my $category = $result = 'Promoted' || $result eq 'Kept' ? 'Successful' : 'Failed'; $text = join "", "== $result ==\n", "\n", "\n", "\n", "\n", " \n", "\n";

$editor->edit ({           page => $archive,            text => $text,            summary => "Created new page for $year/$result",            minor => 0,        }) or            error_exit ("Unable to find '$archive'"); };

$cred->showtime ("   updating $archive\n"); $text =~ s//$1\n{{$assessment}}/s or       $cred->showtime ("unable to find review section - please fix the comment on the page!\n");
 * 1)    print $text, "\n";

$editor->edit ({       page => $archive,        text => $text,        summary => $summary,        minor => 0,    }) or        error_exit ("Unable to edit '$archive'"); }

sub step5 ($) { $cred->showtime ("Step5: Update the announcements page\n"); my ($summary) = @ARG; my $announcements = "Template:WPMILHIST Announcements"; my $text = $editor->get_text ($announcements) or       error_exit ("unable to find '$announcements'");

my $link = "$pagename"; $text =~ s/WP:/Wikipedia:/g; $text =~ s/(&bull;)* \Q$link//s; $editor->edit ({       page => $announcements,        text => $text,        summary => $summary,        minor => 0,    }) or        error_exit ("Unable to edit '$announcements'"); }
 * 1)    print $text, "\n";
 * 1)    print $text, "\n";

sub step6 ($) { $cred->showtime ("Step6: Update the article showcase\n"); my ($summary) = @ARG; my $showcase_a = 'Wikipedia:WikiProject Military history/Showcase/A'; my $text = $editor->get_text ($showcase_a) or       error_exit ("unable to find '$showcase_a'"); my $showcase = new showcase ($text);
 * 1)    print $text, "\n";

if ($outcome eq 'pass') { $showcase->add ($pagename); }

if ($outcome eq 'demoted') { $showcase->del ($pagename); }

$editor->edit ({       page => $showcase_a,        text => $showcase->text,        summary => $summary,        minor => 0,    }) or        error_exit ("unable to edit '$showcase_a'"); }

sub step7 ($) { $cred->showtime ("Step7: Update the newsletter\n"); my ($summary) = @ARG;

sub nominator_list { my @nominators = map {"$ARG"} nominators ; if (1 == @nominators) { return $nominators[0]; } else { my $last = pop @nominators; my $nominator_list = join ', ', @nominators; $nominator_list = join ' and ', $nominator_list, $last; return $nominator_list; }   }

my $nominator_list = nominator_list ; my $new_entry = "; $pagename ($nominator_list)\n";

my @months = qw(January February March April May June July August September October November December); my $next_date = "$months[$next_month] $next_year"; my $newsletter ="Wikipedia:WikiProject Military history/News/$next_date/Articles"; my $text = $editor->get_text ($newsletter);

if ($text) { $cred->showtime ("\tupdating $newsletter\n");

my @a = split(/^/, $text); my @b; my $inserting = 0; my $inserted = 0;

foreach (@a) { if (/New A-Class articles/) { $inserting = 1; }           if (/Footer/) { if (! $inserted) { my $x = pop @b; if ($x !~ /^\s*$/) { push @b, $x; }                   push @b, $new_entry, "\n"; }           }            if ($inserting) { if (/^;\[\[(.+?)\]\]/) { if ($Collator->cmp ($1, $new_entry) > 0) { push @b, "\n", $new_entry; $inserting = 0; $inserted = 1; }               }                if (/^$/) { push @b, "\n", $new_entry; $inserting = 0; $inserted = 1; }           }            push @b, $ARG; }

$text = join '', @b;

}else { $cred->showtime ("\tcreating $newsletter\n");

$text = join "", "{{Wikipedia:WikiProject Military history/News/$next_date/Header}}\n\n", "{{WPMILHIST Newsletter section header 2|New featured articles}}\n\n", "{{WPMILHIST Newsletter section header 2|New featured lists}}\n\n", "{{WPMILHIST Newsletter section header 2|New featured topics}}\n\n", "{{WPMILHIST Newsletter section header 2|New featured pictures}}\n\n", "{{WPMILHIST Newsletter section header 2|New featured portals}}\n\n", "{{WPMILHIST Newsletter section header 2|New A-Class articles}}\n", $new_entry, "\n", "{{Wikipedia:WikiProject Military history/News/$next_date/Footer}}\n\n"; }

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

sub step8 ($$) { $cred->showtime ("Step8: Tracking award eligibility\n"); my ($coordinator, $summary) = @ARG;

sub awards ($) { my ($nominator) = @ARG; my @archives = ('Wikipedia talk:WikiProject Military history/Awards',               'Wikipedia talk:WikiProject Military history/Awards/ACR/Archive 2',                'Wikipedia talk:WikiProject Military history/Awards/ACR/Archive 1'); foreach my $archive (@archives) { my $text = $editor->get_text ($archive) or               error_exit ("unable to find '$archive'");

my @lines = reverse split(/^/, $text); foreach (@lines) { if (/$nominator \((\d+)\)/i) { my $count = $1; $cred->showtime ("$nominator has $count A class medals\n"); return $count; }              }        }        return 0; }

sub award ($) { my ($awards) = @ARG; my $award; my $articles_per_award; my $tracking; my $acm_tracking = 'Wikipedia:WikiProject Military history/Awards/ACM/Eligibility tracking'; my $acc_tracking = 'Wikipedia:WikiProject Military history/Awards/ACC/Eligibility tracking'; if ($awards < 5) { $award = 'A-Class medal'; $articles_per_award = 3; $tracking = $acm_tracking; } elsif ($awards < 10) { $award = 'A-Class medal with Oak Leaves'; $articles_per_award = 3; $tracking = $acm_tracking; } elsif ($awards < 20) { $award = 'A-Class medal with Swords'; $articles_per_award = 3; $tracking = $acm_tracking; } elsif ($awards < 35) { $award = 'A-Class medal with Diamonds'; $articles_per_award = 3; $tracking = $acm_tracking; } elsif ($awards < 40) { $award = 'A-Class cross'; $articles_per_award = 5; $tracking = $acc_tracking; } elsif ($awards < 46) { $award = 'A-Class cross with Oak Leaves'; $articles_per_award = 5; $tracking = $acc_tracking; } elsif ($awards < 56) { $award = 'A-Class cross with Swords'; $articles_per_award = 5; $tracking = $acc_tracking; } else { $award = 'A-Class cross with Diamonds'; $articles_per_award = 5; $tracking = $acc_tracking; }       return ($award, $articles_per_award, $tracking); }

sub nomination ($$$@) { my ($coordinator, $nominee, $award, $awards, @pages) = @ARG; my $nomination_page = 'Wikipedia_talk:WikiProject_Military_history/Awards';

my $text = $editor->get_text ($nomination_page) or           error_exit ("unable to find '$nomination_page'");

my @a = reverse split(/^/, $text); my @b; my $inserted = 0; my $skipping = 1; foreach (@a) { push @b, $ARG; if ($award =~ /A-Class medal/) { if (/showtime ("\tupdating nomination page $nomination_page\n"); $editor->edit ({           page => $nomination_page,            text => $text,            summary => "$nomineee ($awards)",            minor => 0,        }) or            error_exit ("unable to edit $nomination_page"); }   # Find the nominators on the tracking pages my @nominators = nominators ; foreach my $nominator (@nominators) { my $awards = awards($nominator) + 1; my ($award, $articles_per_award, $tracking) = award ($awards); my $text = $editor->get_text ($tracking) or           error_exit ("unable to find '$tracking'");
 * 1)                push @b, "$award: for $pages[0], $pages[1], and $pagename\n";

foreach ($text) { if (/# $nominator:*(.*)/) { $cred->showtime ("\tFound nominator $nominator in tracking list\n"); my $string = $1; my $count = 0; my @pages; while ($string =~ /\/g) { $count++; push @pages, $1; }               $cred->showtime ("\tfound $count nominations for $nominator\n"); ++$count; if ($count < $articles_per_award) { s/(# $nominator:*.*)/$1 /; } else { s/(# $nominator:*)(.+)/$1/; nomination ($coordinator, $nominator, $award, $awards, $pages[0], $pages[1], $pagename); }           } else { $cred->showtime ("\tCould not find nominator $nominator in tracking list -- adding\n"); my @a = split(/^/, $text); my @b; my $found = 0; my $inserted = 0; foreach (@a) { if (!$inserted) { if (/^# (.+):*/) { $found++; if ($1 gt $nominator) { push @b, "# $nominator: \n"; $inserted = 1; }                       }                        if (/^$/ && $found) { push @b, "# $nominator: \n"; $inserted = 1; }                   }                    push @b, $ARG; }               $text = join '', @b; }           $cred->showtime ("\tupdating tracking page $tracking\n"); $editor->edit ({               page => $tracking,                text => $text,                summary => $summary,                minor => 0,            }) or                error_exit ("unable to edit $tracking"); }   }             }

sub pass ($) { $cred->showtime ("Passing $pagename\n"); my ($coordinator) = @ARG; my $comment = "Article promoted by $coordinator via"; my $summary = "$pagename Passed A class review";

step4a ($summary); step1 ($comment, $summary); step23 ('approved', $summary); step4b ('Promoted', $summary); step5 ($summary); step6 ($summary); step7 ($summary); step8 ($coordinator, $summary); $cred->showtime ("done\n"); }

sub failed ($) { $cred->showtime ("Failing $pagename\n"); my ($coordinator) = @ARG; my $comment = "No consensus to promote at this time - $coordinator via"; my $summary = "$pagename failed A class review";

step4a ($summary); step1 ($comment, $summary); step23 ('not approved', $summary); step4b ('Failed', $summary); step5 ($summary); $cred->showtime ("done\n"); }

sub kept ($) { $cred->showtime ("Keeping $pagename\n"); my ($coordinator) = @ARG; my $comment = "Article still meets A-Class criteria - $coordinator via"; my $summary = "$pagename kept after A class reappaisal";

step4a ($summary); step1 ($comment, $summary); step23 ('kept', $summary); step4b ('Kept', $summary); step5 ($summary); $cred->showtime ("done\n"); }

sub demoted ($) { $cred->showtime ("Demoting $pagename\n"); my ($coordinator) = @ARG; my $comment = "Article no longer meets A-Class criteria - $coordinator via"; my $summary = "$pagename demoted after A class reappaisal";

step4a ($summary); step1 ($comment, $summary); step23 ('demoted', $summary); step4b ('Demoted', $summary); step5 ($summary); step6 ($summary); $cred->showtime ("done\n"); }

sub find_pages { my @pages; my $text = $editor->get_text($aclass_review) or       error_exit "Unable to find '$aclass_review'\n"; my @lines = split/\n/, $text; foreach (@lines) { s/_/ /g; if (/ACR\/(Closing|Instructions)/) { next; }       if (/{{Wikipedia:WikiProject Military history\/Assessment\/(.+)}}/) { push @pages, $1; }   }    return @pages; }
 * 1)    print $text;

sub iscoordinator ($) { my ($user) = @ARG; my $category = 'WikiProject Military history coordinators'; my @coordinators = $editor->get_pages_in_category ($category); foreach my $coordinator (@coordinators) { return 1 if "User:$user" eq $coordinator; }   # Try on meta my $meta = MediaWiki::Bot->new ({       host        => 'meta.wikimedia.org',        protocol     => 'https',    }) or die "new MediaWiki::Bot failed";
 * 1)        print $coordinator, "\n";
 * 1)        assert        => 'bot',

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

my @meta_coordinators = $meta->get_pages_in_category ($category); foreach my $meta_coordinator (@meta_coordinators) { return 1 if "User:$user" eq $meta_coordinator; }
 * 1)        print $meta_coordinator, "\n";

return 0; }

sub whodunnit ($) { my ($status) = @ARG; my $user; my @history = $editor->get_history ($talkpage) or       error_exit ("unable to get history of $talkpage'"); foreach my $history (@history) { $user //= $history->{user}; my $text = $editor->get_text ($talkpage, $history->{revid}) or           error_exit ("unable to find '$talkpage' revid $history->{revid}"); if ($text =~ /A-Class\s*=\s*(\w+)/i) { last if ($1 ne $status); } else { last; }       $user = $history->{user}; }   return $user; }
 * 1)        print "user=", $history->{user}, ", revid=", $history->{revid}, "\n";
 * 1)            print "status=$1\n";
 * 1)    print "user=", $user, "\n";

sub outcome { while (1) { my $text = $editor->get_text ($talkpage) or           error_exit ("Unable to find '$talkpage'");

if ($text !~ /A-Class\s*=\s*(\w+)/i) { $cred->showtime ("unable to find A-Class on $talkpage\n"); # See if the assessment is a redirect my $t = $editor->get_text($assessment) or               error_exit "Unable to find '$assessment'\n";

if ($t =~ /REDIRECT \[\[(.+)\]\]/) { $cred->showtime ("'$assessment' redirects to '$1'\n"); $redirect = $assessment; $assessment = $1; if ($assessment =~ /Wikipedia:WikiProject Military history\/Assessment\/(.+)/) { $pagename = $1; $talkpage = "Talk:$pagename"; redo; }           }            return 'unknown'; }       return lc $1; } }

sub clear_outcome { while (1) { my $text = $editor->get_text ($talkpage) or           error_exit ("Unable to find '$talkpage'");

if ($text !~ /A-Class=(\w+)/i) { $cred->showtime ("unable to find A-Class on $talkpage\n"); # See if the assessment is a redirect my $t = $editor->get_text($assessment) or               error_exit "Unable to find '$assessment'\n"; if ($t =~ /REDIRECT \[\[(.+)\]\]/) { $cred->showtime ("'$assessment' redirects to '$1'\n"); $redirect = $assessment; $assessment = $1; if ($assessment =~ /Wikipedia:WikiProject Military history\/Assessment\/(.+)/) { $pagename = $1; $talkpage = "Talk:$pagename"; redo; }           }        }    } }

sub process_pages { set_date ; my @pages = find_pages ; foreach my $p (@pages) { $pagename = $p;

$cred->showtime ("Checking $pagename...\n"); $assessment = "Wikipedia:WikiProject Military history/Assessment/$pagename"; $pagename =~ s/\/archive\d+//; $pagename =~ s/_/ /g; $talkpage = "Talk:$pagename"; $redirect = undef;

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

if ($outcome eq 'current') { next; } elsif ($outcome eq 'unknown') { next; } else { my $user = whodunnit ($outcome); if (iscoordinator ($user)) { $cred->showtime ("$user is a ccoordinator\n"); } else { $cred->warning ("$user is NOT a ccoordinator\n"); next; }

my $coordinator = "$user (talk)"; if ($outcome eq 'pass') { pass ($coordinator); } elsif ($outcome eq 'fail') { failed ($coordinator); } elsif ($outcome eq 'kept') { kept ($coordinator); } elsif ($outcome eq 'demoted') { demoted ($coordinator); } else { $cred->warning ("unknown outcome: '$outcome'\n"); }       }    } }

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

$cred->showtime ("begin\n"); process_pages ; $cred->showtime ("end\n");

exit 0;

}}