#!/usr/bin/perl -w
# announcements.pl -- Update the MilHist announcements page
# Usage: announcements.pl
# 3 Oct 14 Created
# 14 Oct 14 Sort entries in chronological order
# 17 Oct 14 Handle GA2 etc
use English;
use strict;
use utf8;
use warnings;
use Carp;
use File::Basename qw(dirname);
use Data::Dumper;
use IO::File;
use MediaWiki::Bot;
use POSIX;
use Time::Local;
use XML::Simple;
binmode (STDERR, ':utf8');
binmode (STDOUT, ':utf8');
my $dirname = dirname (__FILE__, '.pl');
push @INC, $dirname;
require Cred;
my $cred = new Cred ();
my $log = $cred->log ();
my %timestamp;
my %month = ('January' => 0, 'February' => 1, 'March' => 2, 'April' => 3, 'May' => 4, 'June' => 5,
'July' => 6, 'August' => 7, 'September' => 8, 'October' => 9, 'November' => 10, 'December' => 11);
my $editor = MediaWiki::Bot->new ({
assert => 'bot',
host => 'en.wikipedia.org',
protocol => 'https',
}) or die "new failed";
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 is_milhist ($) {
my ($page) = @ARG;
my $talkpage = "Talk:$page";
my $text = $editor->get_text ($talkpage) or do {
$cred->showtime ("Unable to find '$talkpage'\n");
return 0;
};
return $text =~ /{{WikiProject Military history|{{MILHIST|{{WPMILHIST/i;
}
sub timestamp ($) {
my ($candidate) = @ARG;
my @history = $editor->get_history ($candidate) or
error_exit "Unable get history of '$candidate'";
my $created = pop @history;
my ($hour, $min, $sec) = $created->{timestamp_time} =~ /(\d+):(\d+):(\d+)/;
my ($year, $mon, $day) = $created->{timestamp_date} =~ /(\d+)-(\d+)-(\d+)/;
return timegm ($sec, $min, $hour, $day, $mon-1, $year);
}
sub aclass () {
my $candidates = 'Wikipedia:WikiProject Military history/Assessment/A-Class review';
my %candidates;
my $text = $editor->get_text ($candidates) or
error_exit "Unable to find '$candidates'";
my @candidates = $text =~ /(Wikipedia:WikiProject Military history\/Assessment\/[^}]+)/g;
foreach my $candidate (@candidates) {
if ($candidate =~ /Wikipedia:WikiProject Military history\/Assessment\/([^}]+)/) {
my $page = $1;
next if $page =~ /^ACR/;
$cred->showtime ("\t$page\n");
$candidates{$page} = $candidate;
$timestamp{$page} = timestamp ($candidate);
}
}
return %candidates;
}
sub featured ($) {
my ($candidates) = @ARG;
my %candidates;
my $text = $editor->get_text ($candidates) or
error_exit "Unable to find '$candidates'";
my @candidates = $text =~ /($candidates\/.+\/archive\d+)/g;
foreach my $candidate (@candidates) {
if ($candidate =~ /$candidates\/(.+)\/archive\d+/) {
my $page = $1;
if (is_milhist ($page)) {
$cred->showtime ("\t$page\n");
$candidates{$page} = $candidate;
$timestamp{$page} = timestamp ($candidate);
}
}
}
return %candidates;
}
sub good_article_timestamp ($) {
my ($candidate) = @ARG;
my $text = $editor->get_text ($candidate) or
error_exit "Unable to find '$candidate'";
if ($text =~ /GA nominee\|(\d+):(\d+), (\d+) (\w+) (\d+)/) {
my ($hour, $min, $day, $month, $year) = ($1, $2, $3, $4, $5);
my $sec = 0;
my $mon = $month{$month};
return timegm ($sec, $min, $hour, $day, $mon, $year);
} else {
error_exit "Unable to find GA nominee in '$candidate'";
}
}
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 good_article_entry ($) {
my ($page) = @ARG;
my $entry = "\{\{WPMHA\/GAN\|$ARG\}\}";
my $talk = "Talk:$page";
my $text = $editor->get_text ($talk) or
error_exit "Unable to find '$talk'";
if ($text =~ s/{{GA nominee(.+?)}}//is) {
my %h = parse_template ($1, 'temestamp', 'nominator', 'page', 'topic', 'status', 'note');
my $number = $h{page};
$entry = "{{WPMHA/GAN|$page|$number}}";
}
return $entry;
}
sub good_article_nominees () {
my $candidates = 'Good article nominees';
my @milhist;
my @candidates = $editor->get_pages_in_category ($candidates) or
error_exit "Unable to find '$candidates'";
foreach my $candidate (@candidates) {
if ($candidate =~ /Talk:(.+)/) {
my $page = $1;
if (is_milhist ($page)) {
$cred->showtime ("\t$page\n");
$timestamp{$page} = good_article_timestamp ($candidate);
push @milhist, $page;
}
}
}
return join ' • ', map { good_article_entry ($ARG) } sort { $timestamp{$a} <=> $timestamp{$b} } @milhist;
}
sub peer_reviews () {
my $candidates = 'Current peer reviews';
my %candidates;
my @candidates = $editor->get_pages_in_category ($candidates) or
error_exit "Unable to find '$candidates'";
foreach my $candidate (@candidates) {
if ($candidate =~ /Wikipedia:Peer review\/(.+)\/archive\d+/) {
my $page = $1;
if (is_milhist ($page)) {
$cred->showtime ("\t$page\n");
$candidates{$page} = $candidate;
$timestamp{$page} = timestamp ($candidate);
}
}
}
return %candidates;
}
sub format_up (%) {
my %pages = (@ARG);
return join ' • ', map { "[[$pages{$ARG}|$ARG]]" } sort { $timestamp{$a} <=> $timestamp{$b} } keys %pages;
}
$cred->showtime (": started\n");
$editor->login ({
username => $cred->user,
password => $cred->password
}) or error_exit "unable to login";
my $announcements = 'Template:WPMILHIST Announcements';
my $text = $editor->get_text ($announcements) or
die "Unable to find '$announcements'\n";
$cred->error ("no bots allowed on '$announcements'") unless allow_bots ($text, $cred->user);
my $bot = " <!-- Bot generated -->";
$cred->showtime ("A class reviews:\n");
my %acr = aclass ();
my $acr = format_up (%acr);
$text =~ s/A-Class_reviews=.*/A-Class_reviews=$acr $bot/;
$cred->showtime ("Featured article candidates:\n");
my %fac = featured ('Wikipedia:Featured article candidates');
my $fac = format_up (%fac);
$text =~ s/featured_article_candidates=.*/featured_article_candidates=$fac/;
$cred->showtime ("Featured article reviews:\n");
my %far = featured ('Wikipedia:Featured article review');
my $far = format_up (%far);
$text =~ s/featured_article_reviews=.*/featured_article_reviews=$far $bot/;
$cred->showtime ("Featured list candidates\n");
my %flc = featured ('Wikipedia:Featured list candidates');
my $flc = format_up (%flc);
$text =~ s/featured_list_candidates=.*/featured_list_candidates=$flc $bot/;
$cred->showtime ("Featured list removal candidates\n");
my %flr = featured ('Wikipedia:Featured list removal candidates');
my $flr = format_up (%flr);
$text =~ s/featured_list_removal_candidates=.*/featured_list_removal_candidates=$flr $bot/;
$cred->showtime ("Peer review:\n");
my %pr = peer_reviews ();
my $pr = format_up (%pr);
$text =~ s/peer_reviews=.*/peer_reviews=$pr $bot/;
$cred->showtime ("Good article nominees:\n");
my $gan = good_article_nominees ();
$text =~ s/good_article_nominees=.*/good_article_nominees=$gan $bot/;
$editor->edit ({
page => $announcements,
text => $text,
summary => "Updating announcements page",
bot => 1,
minor => 0,
}) or
error_exit ("unable to edit '$announcements'");
$cred->showtime (": finished\n");
$log->close ();
exit 0;
