User:FACBot/flc.pl

{{syntaxhighlight|lang=perl|code=
 * 1) !/usr/bin/perl -w
 * 2) flc.pl -- Pass or fail an Featured Article class review
 * 3)     This Bot runs every day, looking for featured list articles that have been promoted by a delegate
 * 4)    If it finds one, it follows the steps involved in promoting or failing it.
 * 5) Usage: flc.pl
 * 6)    29 Nov 15 Created
 * 7)    28 Dec 15 Create update_featured_list_log
 * 8)    11 Jan 16 Do not leave a blank line on the nomination page
 * 9)                Put the FLC star before DEFAULTSORT
 * 10)    24 Jan 16 Featured list removal
 * 11)    17 Aug 16 Corrected typo causing duplicated Featured log entries
 * 12)     3 Sep 17 Correction for new announcements page format
 * 13)    16 Nov 17 Correct revid in article history
 * 1)    16 Nov 17 Correct revid in article history

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

use Carp; use Data::Dumper; use Date::Calc qw(Delta_Days); 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 = 'Wikipedia:featured list candidates'; my $category = 'Wikipedia featured list candidates'; my $removal_candidates = 'Wikipedia:featured list removal candidates'; my $removal_category = 'Wikipedia featured list removal candidates'; my $removal_log = 'Wikipedia:Featured list removal candidates/log/%M %Y'; my $promoted_log = 'Wikipedia:Featured list candidates/Featured log/%M %Y'; my $failed_log = 'Wikipedia:Featured list candidates/Failed log/%M %Y'; my $announcements = 'Template:Announcements/New featured content'; my $goings_on = 'Wikipedia:Goings-on'; my $featured_list_log = 'Template:Featured list log'; my $nomination_page; # used only for testing
 * 1) Pages used

my @months = qw(January February March April May June July August September October November December);

my $sandbox_test = 0; if ($sandbox_test) { $candidates = 'User:Hawkeye7/sandbox/test1'; $nomination_page = 'User:Hawkeye7/sandbox/test2'; $category = 'Hawkeye7 test pages'; $promoted_log = 'User:Hawkeye7/Featured log/%M %Y'; $failed_log = 'User:Hawkeye7/Failed log/%M %Y'; $announcements = 'User:Hawkeye7/sandbox/test3'; $goings_on = 'User:Hawkeye7/sandbox/test4'; $featured_list_log = 'User:Hawkeye7/sandbox/test5'; }

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 ;

sub showtime (@) { print $log strftime ('%H:%M:%S %a %d %b %Y', localtime (time)), @ARG; }

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

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 whodunnit ($$) { my ($article, $nomination) = @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}')");        die "no bots allowed on '$nomination'" unless allow_bots ($text, $cred->user);
 * 1)        print Dumper $revision, "\n";

if ($text !~ /{{FLCClosed\|(.+?)}}/) { my $action = $1; print $log "\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, $revision->{revid}); } else { $old = $revision; }   } }
 * 1)            print $diff, "\n";

sub has_been_closed ($$) { my ($article, $nomination) = @ARG; print $log "checking if $nomination has been promoted...\n"; my $text = $editor->get_text ($nomination) or do { # Nomination in progress? showtime ("Unable to find nomination page '$nomination')");       return ;    };

if ($text =~ /{{FLCClosed\|(.+?)}}/) { # No timestamp - get it from whodunnit my $status = $1; my ($coordinator, $date, $time, $diff, $revid) = whodunnit ($article, $nomination);

$date =~ /(\d+)-(\d+)-(\d+)/; my ($year, $month, $day) = ($1, $2, $3); $day =~ s/^0//; $month = $months[$month-1]; my %timestamp; $timestamp{DISPLAY_DATE} = "$time $day $month $year"; $timestamp{TIME} = $time; $timestamp{DATE} = $date; $timestamp{DAY} = $day; $timestamp{MONTH} = $month; $timestamp{YEAR} = $year; $timestamp{USER} = $coordinator; $timestamp{DIFF} = $diff; $timestamp{REVID} = $revid; $timestamp{STATUS} = $status;
 * 1)        print "date='$date' time='$time'\n";

return ($status, \%timestamp); }   return ; }

sub find_the_nomination_page ($) { my ($talk) = @ARG; if ($sandbox_test) { return $nomination_page; }

my $text = $editor->get_text ($talk) or       error_exit ("Unable to find '$talk')");    die "no bots allowed on '$talk'" unless allow_bots ($text, $cred->user);

$text =~ /{{featured list candidates\|(.+?\/archive\d+)}}/ or do { error_exit ("Unable to find nomination page for '$talk'"); };   my $nomination = "Wikipedia:Featured list candidates/$1"; my $encoded_nomination = $nomination; $nomination =~ s/&#([0-9a-f]+);/chr($1)/ige; print "\t$nomination\n"; return ($nomination, $encoded_nomination); }

sub archive_nomination ($$$$) { print "\tArchiving the nomination\n"; my ($nomination, $comment, $summary,$timestamp) = @ARG; my $text = $editor->get_text ($nomination) or       error_exit ("Unable to find '$nomination'"); die "no bots allowed on '$nomination'" unless allow_bots ($text, $cred->user);

my $status = $timestamp->{STATUS}; my $coordinator = $timestamp->{USER}; my $diff = $timestamp->{DIFF}; $text = join "\n", "{{subst:Fl top |result= $status by $coordinator via ~ [$diff]}}", $text, '{{subst:Fl bottom}}';

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

}

sub remove_nomination_from_candidates_page ($$) { print "\tRemoving the nomination from the candidates page\n"; my ($nomination, $summary) = @ARG; my $text = $editor->get_text ($candidates) or       error_exit ("Unable to find '$candidates'"); die "no bots allowed on '$candidates'" unless allow_bots ($text, $cred->user);

$text =~ s/{{\Q$nomination\E}}\s*\n//s;

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

sub add_nomination_to_log_page ($$$$) { print "\tAdding the nomination to the log page\n"; my ($nomination, $summary, $timestamp, $log) = @ARG; $log =~ s/%M/$timestamp->{MONTH}/; $log =~ s/%Y/$timestamp->{YEAR}/; my $text = $editor->get_text ($log); if (!defined $text) { $text = "{{Featured list log}}\n{{TOClimit|3}}\n\n"; }   die "no bots allowed on '$log'" unless allow_bots ($text, $cred->user); $text =~ s/({{TOClimit\|\d+}}\n\n)/$1\{\{$nomination\}\}\n/s;

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

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

my $tag = '{{featured list}}'; if ($text !~ s/(\{\{DEFAULTSORT)/$tag\n$1/i) { if ($text !~ s/(\[\[Category:)/$tag\n$1/i) { $text .= "$tag\n"; }   }

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

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

my $in_list_section = 0; my $section_max; my @input_lines = split /\n/, $text; my @output_lines; foreach (@input_lines) { if (//) { $section_max = $1; $in_list_section++; my $a = $article; if ($a =~ s/List of //) { push @output_lines, $ARG, "* $a"; } else { push @output_lines, $ARG, "* $article"; }           next; }       if ($in_list_section) { if (/^$|<\/div>|/) { $in_list_section = 0; } elsif ($in_list_section < $section_max) { $in_list_section++; } else { next; }       }        push @output_lines, $ARG; }

$text = join "\n", @output_lines;

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

sub text_to_month ($) { my ($month) = @ARG; for my $i (0..11) { if ($months[$i] eq $month) { return $i + 1; }   }       }

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

my ($m, $d, $y) = $text =~ /week starting Sunday, \[\[(\w+) (\d+)\]\], \[\[(\d+)\]\]/; my $delta_days = Delta_Days ($y, text_to_month ($m), $d, $timestamp->{YEAR}, text_to_month ($timestamp ->{MONTH}), $timestamp->{DAY}); if ($delta_days < 0) { print $log "\t\tArticle dated $timestamp->{DAY} $timestamp ->{MONTH} $timestamp->{YEAR} but page is $d $m $y -- skipping\n"; return; }
 * 1)    print "$d $m $y\n";
 * 1)    print "delta days=$delta_days\n"; # Normally positive

my $abbr = substr ($timestamp ->{MONTH}, 0, 3); my $date = "$timestamp->{DAY} $abbr";

my $in_list_section = 0; my @input_lines = split /\n/, $text; my @output_lines; foreach (@input_lines) { if (/Wikipedia:Featured lists/) { $in_list_section = 1; }       if ($in_list_section) { if (/^$|Wikipedia:Featured pictures/) { $in_list_section = 0; push @output_lines, "* $article ($date)"; }       }        push @output_lines, $ARG; }

$text = join "\n", @output_lines;

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

sub update_featured_list_log ($$$) { print "\tUpdating the featured list log\n"; my ($status, $summary, $timestamp) = @ARG; my $text = $editor->get_text ($featured_list_log) or       error_exit ("Unable to find '$featured_list_log'"); die "no bots allowed on '$featured_list_log'" unless allow_bots ($text, $cred->user);

my $year = $timestamp->{YEAR}; my $month = $timestamp->{MONTH};

sub new_month ($$$$$$) { my ($month, $year, $promoted, $failed, $kept, $removed) = @ARG; my @new_year = ($month eq 'January') ? ('|-', "|colspan=\"3\"|$year") : ; return join "\n", @new_year, '|-', "|$month", "|$promoted promoted", "|$failed failed", "|$removed removed/$kept kept", "|}";   }

foreach ($text) { if ($status eq 'promoted') { if (/(\|\[\[Wikipedia:Featured list candidates\/Featured log\/$month $year\|)(\d+) promoted/) { my $match = $1; my $count = $2 + 1; s/\Q$match\E\d+ promoted/$match$count promoted/; } else { my $new_month = new_month ($month, $year, 1, 0, 0, 0); s/\|}/$new_month/; }       } elsif ($status eq 'failed') { if (/(\|\[\[Wikipedia:Featured list candidates\/Failed log\/$month $year\|)(\d+) failed/) { my $match = $1; my $count = $2 + 1; s/\Q$match\E\d+ failed/$match$count failed/; } else { my $new_month = new_month ($month, $year, 0, 1, 0, 0); s/\|}/$new_month/; }

} elsif ($status eq 'kept') { if (/(\|\[\[Wikipedia:Featured list removal candidates\/log\/$month $year\|)(\d+) removed\/(\d+) kept/) { my $match = $1; my $removed = $2; my $kept = $3 + 1; s/\Q$match\E.+/$match$removed removed\/$kept kept]]/; } else { my $new_month = new_month ($month, $year, 0, 0, 1, 0); s/\|}/$new_month/; }          } elsif ($status eq 'removed') { if (/(\|\[\[Wikipedia:Featured list removal candidates\/log\/$month $year\|)(\d+) removed\/(\d+) kept/) { my $match = $1; my $removed = $2 + 1; my $kept = $3; s/\Q$match\E.+/$match$removed removed\/$kept kept]]/; } else { my $new_month = new_month ($month, $year, 0, 0, 0, 1); s/\|}/$new_month/; }          } else { die "unknown status: '$status'"; }   }    $editor->edit ({        page => $featured_list_log,        text => $text,        summary => $summary,        minor => 0,    }) or        error_exit ("unable to edit '$featured_list_log'"); }

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 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 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_current_status ($$) { my ($text, $current_status) = @ARG;

if ($current_status) { foreach ($text) { unless (s/(currentstatus=\s*\w+)/currentstatus=$current_status/) { s///s; }       }    }    return $text; }

sub update_article_history ($$$$$$$) { my ($text, $action, $date, $link, $result, $revid, $current_status) = @ARG; $text =~ s/{{Article\s*History/{{ArticleHistory/is; my ($articleHistory) = $text =~ /{{ArticleHistory(.+?)}}/gis; if ($articleHistory) { my $has_nested_text = 0; 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";

id: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 id; }       }        $text = update_current_status ($text, $current_status); 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; $text = update_current_status ($text, $current_status); }

return $text; }

sub add_pr_to_history ($$) { my ($article, $text) = @ARG; print $log "\tFound old Peer Review\n"; while ($text =~ s/{{oldpeerreview(.+?)}}//is) { my %h = parse_template ($1, 'name', 'archive');

my $name = $h{name} // $article; my $archive = defined $h{archive} ? "/archive$h{archive}" : ''; my $link = "Wikipedia:Peer_review/$name$archive"; my ($history) = $editor->get_history ($link) or           error_exit ("Unable to get history of '$link'"); my $date = $history->{timestamp_date}; my $time = $history->{timestamp_time}; my $revid = get_revid ($article, $date, $time); $text = update_article_history ($text, 'PR', $date, $link, 'reviewed ', $revid, undef); }   return $text; }

sub update_talk_page ($$$$$$) { print "\tUpdating the talk page\n"; my ($status, $article, $talk, $nomination, $summary, $timestamp) = @ARG; my $text = $editor->get_text ($talk) or       error_exit ("Unable to find '$talk'"); die "no bots allowed on '$talk'" unless allow_bots ($text, $cred->user);

my $revid = get_revid ($article, $timestamp->{DATE}, $timestamp->{TIME});

# add an old Peer review, if any, to the article history if ($text =~ /{{oldpeerreview.+?}}/gis) { $text = add_pr_to_history ($article, $text); }   if ($status eq 'promoted') { # Remove the FLC card $text =~ s/{{featured list candidates.+?}}\s*//; # Update the class for all projects $text =~ s/([^-]class)\s*=\s*(\w+)/$1=FL/igs; $text = update_article_history ($text, 'FLC', $timestamp->{DISPLAY_DATE}, $nomination, 'promoted', $revid, 'FL');

} elsif ($status eq 'failed') { # Remove the FLC card $text =~ s/{{featured list candidates.+?}}\s*//; $text = update_article_history ($text, 'FLC', $timestamp->{DISPLAY_DATE}, $nomination, 'failed', $revid, 'FFLC'); } elsif ($status eq 'kept') { # Remove the FLR card $text =~ s/{{featured list removal candidates.+?}}\s*//; $text = update_article_history ($text, 'FLR', $timestamp->{DISPLAY_DATE}, $nomination, 'kept', $revid, 'FL');

} elsif ($status eq 'removed') { # Remove the FLR card $text =~ s/{{featured list removal candidates.+?}}\s*//; # Update the class for all projects $text =~ s/([^-]class)\s*=\s*(\w+)/$1=List/igs; $text = update_article_history ($text, 'FLR', $timestamp->{DISPLAY_DATE}, $nomination, 'removed', $revid, 'FFL'); } else { die "unknown status: '$status'"; }

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

sub find_the_removal_nomination_page ($) { my ($talk) = @ARG; if ($sandbox_test) { return $nomination_page; }

my $text = $editor->get_text ($talk) or       error_exit ("Unable to find '$talk')");    die "no bots allowed on '$talk'" unless allow_bots ($text, $cred->user);

$text =~ /{{featured list removal candidates\|(.+?\/archive\d+)}}/ or do { error_exit ("Unable to find nomination page for '$talk'"); };   my $nomination = "Wikipedia:Featured list removal candidates/$1"; my $encoded_nomination = $nomination; $nomination =~ s/&#([0-9a-f]+);/chr($1)/ige; print "\t$nomination\n"; return ($nomination, $encoded_nomination); }

sub remove_nomination_from_removal_candidates_page ($$) { print "\tRemoving the nomination from the removal candidates page\n"; my ($nomination, $summary) = @ARG; my $text = $editor->get_text ($removal_candidates) or       error_exit ("Unable to find '$removal_candidates'"); die "no bots allowed on '$removal_candidates'" unless allow_bots ($text, $cred->user);

$text =~ s/{{\Q$nomination\E}}\s*\n//s;

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

sub add_nomination_to_removal_log_page ($$$$) { print "\tAdding the nomination to the log page\n"; my ($nomination, $summary, $timestamp, $log) = @ARG; my $status = $timestamp->{STATUS}; $log =~ s/%M/$timestamp->{MONTH}/; $log =~ s/%Y/$timestamp->{YEAR}/; my $text = $editor->get_text ($log); if (!defined $text) { $text = "{{Featured list log}}\n{{TOClimit|3}}\n==Keep==\n\n==Delist==\n"; }   die "no bots allowed on '$log'" unless allow_bots ($text, $cred->user);

if ($status eq 'kept') { $text =~ s/(==Keep==\n)/$1\{\{$nomination\}\}\n/s; } elsif ($status eq 'removed') { $text =~ s/(==Delist==\n)/$1\{\{$nomination\}\}\n/s; }

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

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

$text =~ s/\{\{featured list\}\}\s*\n//is;

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

sub promoted ($$$$) { my ($article, $talk, $nomination, $timestamp) = @ARG; my $coordinator = $timestamp->{USER}; my $status = $timestamp->{STATUS};

print "\tpromoting $article\n"; my $comment = "The list was $status by $coordinator via"; my $summary = "$article promoted to Featured List"; update_talk_page ('promoted', $article, $talk, $nomination, $summary, $timestamp); remove_nomination_from_candidates_page ($nomination, $summary); archive_nomination ($nomination, $comment, $summary, $timestamp); add_nomination_to_log_page ($nomination, $summary, $timestamp, $promoted_log); update_article_page ($article, $summary); update_announcements_page ($article, $summary); update_goings_on_page ($article, $summary, $timestamp); update_featured_list_log ('promoted', $summary, $timestamp);

print "\tdone\n"; }

sub failed ($$$$) { my ($article, $talk, $nomination, $timestamp) = @ARG; my $coordinator = $timestamp->{USER}; my $status = $timestamp->{STATUS};

print "\tnot promoting $article\n"; my $comment = "The list was $status by $coordinator via"; my $summary = "$article not promoted to Featured List"; update_talk_page ('failed', $article, $talk, $nomination, $summary, $timestamp); remove_nomination_from_candidates_page ($nomination, $summary); archive_nomination ($nomination, $comment, $summary, $timestamp); add_nomination_to_log_page ($nomination, $summary, $timestamp, $failed_log); update_featured_list_log ('failed', $summary, $timestamp);

print "\tdone\n"; }

sub kept ($$$$) { my ($article, $talk, $nomination, $timestamp) = @ARG; my $coordinator = $timestamp->{USER}; my $status = $timestamp->{STATUS};

print "\tkeeping $article\n"; my $comment = "The list was $status by $coordinator via"; my $summary = "$article kept as Featured List"; update_talk_page ('kept', $article, $talk, $nomination, $summary, $timestamp); remove_nomination_from_removal_candidates_page ($nomination, $summary); archive_nomination ($nomination, $comment, $summary, $timestamp); add_nomination_to_removal_log_page ($nomination, $summary, $timestamp, $removal_log); update_featured_list_log ('kept', $summary, $timestamp);

print "\tdone\n"; }

sub removed ($$$$) { my ($article, $talk, $nomination, $timestamp) = @ARG; my $coordinator = $timestamp->{USER}; my $status = $timestamp->{STATUS};

print "\tremoving $article\n"; my $comment = "The list was $status by $coordinator via"; my $summary = "$article removed from Featured List"; update_talk_page ('removed', $article, $talk, $nomination, $summary, $timestamp); remove_nomination_from_removal_candidates_page ($nomination, $summary); archive_nomination ($nomination, $comment, $summary, $timestamp); add_nomination_to_removal_log_page ($nomination, $summary, $timestamp, $removal_log); remove_star_from_article_page ($article, $summary); update_featured_list_log ('removed', $summary, $timestamp);

print "\tdone\n"; }

sub is_older_nomination ($$) { my ($nomination, $twenty_days_ago) = @ARG;

print $nomination, "\n";

my @history = $editor->get_history ($nomination) or       error_exit ("Unable to get history of '$nomination'");

my $revision = pop @history; print "\t", $revision->{timestamp_date};

my $is_older_nomination = $revision->{timestamp_date} lt $twenty_days_ago; print $is_older_nomination ? " is older than twenty_days_ago\n" : " is NOT older than twenty_days_ago\n" ; return $is_older_nomination; }

sub move_the_daily_marker { my $text = $editor->get_text ($candidates) or       error_exit ("Unable to find '$candidates'"); die "no bots allowed on '$candidates'" unless allow_bots ($text, $cred->user);

my @input = split /\n/, $text; my @output; my $nominations = 0; my @older_nominations; my $older_nominations = 0; my $twenty_days_ago = strftime ('%Y-%m-%d', gmtime(time - 20 * 24 * 60 * 60)); print "twenty days ago was $twenty_days_ago\n";

foreach (@input) { if (//) { }elsif (/==Nominations==/) { $nominations = 1; } elsif (/==Older nominations==/) { $older_nominations = 1; $nominations = 0; } elsif ($nominations) { if (/{{(Wikipedia:Featured list candidates.+)}}/) { my $nomination = $1; if (is_older_nomination ($nomination, $twenty_days_ago)) { push @older_nominations, "{{$nomination}}"; next; }              }           } elsif ($older_nominations) { if (@older_nominations) { push @output, @older_nominations; $older_nominations = 0; }       }        push @output, $ARG; }   return unless (@older_nominations); $text = join "\n", @output; $editor->edit ({       page => $candidates,        text => $text,        summary => 'update daily marker',        minor => 0,    }) or        error_exit ("unable to edit '$candidates'"); }

sub featured_list_candidates { my @candidates = $editor->get_pages_in_category ($category); foreach my $talk (@candidates) { eval { my $article = $talk; if ($article =~ s/Talk://) { print $article, "\n"; my ($nomination, $encoded_nomination) = find_the_nomination_page ($talk); print "\t", $nomination, "\n"; if (my ($status, $timestamp) = has_been_closed ($article, $nomination)) { print $log "\t$nomination closed on $timestamp->{DISPLAY_DATE}\n"; print "\tnomination closed on $timestamp->{DISPLAY_DATE}\n"; if ($status eq 'promoted') { promoted ($article, $talk, $nomination, $timestamp); } elsif ($status eq 'not promoted' || $status eq 'failed' || $status eq 'withdrawn' || $status eq 'archived') { failed ($article, $talk, $nomination, $timestamp); } else { print $log "WARNING: $nomination has unknown status '$status'\n"; warn "WARNING: $nomination has unknown status '$status'\n"; }                      } else { print $log "\tnomination is still current\n"; print "\t$nomination is still current\n"; }           }        };        if ($EVAL_ERROR) { warn $EVAL_ERROR; }   } }

sub featured_list_removal_candidates { my @candidates = $editor->get_pages_in_category ($removal_category); foreach my $talk (@candidates) { eval { my $article = $talk; if ($article =~ s/Talk://) { print $article, "\n"; my ($nomination, $encoded_nomination) = find_the_removal_nomination_page ($talk);

if (my ($status, $timestamp) = has_been_closed ($article, $nomination)) { print $log "\t$nomination closed on $timestamp->{DISPLAY_DATE}\n"; print "\tnomination closed on $timestamp->{DISPLAY_DATE}\n"; if ($status eq 'kept') { kept ($article, $talk, $nomination, $timestamp); } elsif ($status eq 'removed') { removed ($article, $talk, $nomination, $timestamp); } else { print $log "WARNING: $nomination has unknown status '$status'\n"; warn "WARNING: $nomination has unknown status '$status'\n"; }                      } else { print $log "\tnomination is still current\n"; print "\t$nomination is still current\n"; }           }        };        if ($EVAL_ERROR) { warn $EVAL_ERROR; }   } }

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

showtime ("========== Commenced ==========\n"); move_the_daily_marker unless ($sandbox_test); featured_list_candidates ; featured_list_removal_candidates ;

exit 0;

}}