User:AnomieBOT/source/tasks/DRVClerk.pm

package tasks::DRVClerk;

=pod

=begin metadata

Bot:     AnomieBOT
Task:    DRVClerk
BRFA:    Wikipedia:Bots/Requests for approval/AnomieBOT 66
Status:  Approved 2012-08-19
Created: 2012-07-16

Peform the following tasks at [[WP:DRV]]:
* Create the daily DRV subpage.
* Create the monthly DRV subpage.
* Fix the headers on the daily DRV subpages, if they get removed or damaged.
* Maintain the lists at [[WP:DRV#Active discussions]] and [[WP:DRV#Recent discussions]].
* Remove headers from closed non-current discussions.

=end metadata

=cut

use utf8;
use strict;

use AnomieBOT::Task qw/:time/;
use Data::Dumper;
use vars qw/@ISA/;
@ISA=qw/AnomieBOT::Task/;

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

my $screwup;

my $headerContents = '[^=\n](?-s:.*[^=\n])?';

sub new {
    my $class=shift;
    my $self=$class->SUPER::new();
    $self->{'lasttime'}=0;
    $self->{'broken'}=0;
    bless $self, $class;
    return $self;
}

=pod

=for info
Approved 2012-08-19<br />[[Wikipedia:Bots/Requests for approval/AnomieBOT 66]]

=cut

sub approved {
    return 2;
}

sub run {
    my ($self, $api)=@_;
    my $res;

    $api->task('DRVClerk', 0, 10, qw/d::Talk d::Templates d::Redirects d::Sections/);

    # Only check once per hour
    if($self->{'lasttime'}==0){
        if(exists($api->store->{'lasttime'})){
            my $t=$api->store->{'lasttime'};
            $self->{'lasttime'}=$t if($t=~/^\d+$/ && $t<=time());
        }
        $self->{'broken'}=$api->store->{'broken'} if(exists($api->store->{'broken'}));
    }
    my $starttime=time();
    my $t=$self->{'lasttime'}+($self->{'broken'}?300:3600)-$starttime;
    return $t if $t>0;
    # If it's close enough to 23:00, just wait for 23:00.
    $t=82800-($starttime%86400);
    return $t if($t>0 && $t<($self->{'broken'}?300:3600));
    # If it's close enough to 00:00, just wait for 00:00.
    $t=86400-($starttime%86400);
    return $t if($t>0 && $t<($self->{'broken'}?300:1800));

    my $startdate=[10,11,2018];
    $startdate=$api->store->{'startdate'} if exists($api->store->{'startdate'});

    # Get the content of all versions of "DRV top" and "DRV bottom" since the startdate
    my @re_top=();
    my @re_bottom=();
    my %cont=();
    do {
        my $t=$api->query(
            titles  => 'Template:DRV top',
            prop    => 'revisions',
            rvprop  => 'timestamp|content',
            rvslots => 'main',
            rvlimit => 1,
            %cont,
        );
        if($t->{'code'} ne 'success'){
            $api->warn("Failed to load revisions for Template:DRV top: ".$t->{'error'}."\n");
            return 60;
        }
        %cont=exists($t->{'query-continue'})?%{$t->{'query-continue'}{'revisions'}}:();
        $t=(values(%{$t->{'query'}{'pages'}}))[0]{'revisions'}[0];
        %cont=() if $t->{'timestamp'} lt sprintf("%04d-%02d-%02d", reverse @$startdate);
        $t=$t->{'slots'}{'main'}{'*'};
        $t=~s!<noinclude>.*?</noinclude>!!gs;
        $t=~s!</?includeonly>!!g;
        $t=~s!^(?:\s*\n)?====$headerContents====\s*\n!!g;
        $t=~s!\{\{\{.*?\}\}\}!\x07!g;
        $t=~s!\{\{safesubst:.*!\x07!gis;
        $t=quotemeta($t);
        $t=~s/\\\x07/(?s:.*?)/g;
        push @re_top, $t;
    } while(%cont);
    %cont=();
    do {
        my $t=$api->query(
            titles  => 'Template:DRV bottom',
            prop    => 'revisions',
            rvprop  => 'timestamp|content',
            rvslots => 'main',
            rvlimit => 1,
            %cont,
        );
        if($t->{'code'} ne 'success'){
            $api->warn("Failed to load revisions for Template:DRV bottom: ".$t->{'error'}."\n");
            return 60;
        }
        %cont=exists($t->{'query-continue'})?%{$t->{'query-continue'}{'revisions'}}:();
        $t=(values(%{$t->{'query'}{'pages'}}))[0]{'revisions'}[0];
        %cont=() if $t->{'timestamp'} lt sprintf("%04d-%02d-%02d", reverse @$startdate);
        $t=$t->{'slots'}{'main'}{'*'};
        $t=~s!<noinclude>.*?</noinclude>!!gs;
        $t=~s!</?includeonly>!!g;
        $t=~s!\{\{\{.*?\}\}\}!\x07!g;
        $t=quotemeta($t);
        $t=~s/\\\x07/.*?/g;
        push @re_bottom, $t;
    } while(%cont);
    my $re='(?>'.join('|', @re_top).').*?(?:'.join('|', @re_bottom).')';
    $re=qr/$re/s;

    $screwup=' Errors? [[User:'.$api->user.'/shutoff/DRVClerk]]';

    # Iterate over all our pages
    my $broken=0;
    my $today=_make_date();
    my $sevendays=_date_add($today,-7,0,0);
    my $fortnight=_date_add($today,-14,0,0);
    my $new_start=$fortnight;
    my @cur=();
    my @old=();
    my @cursumm=();
    my @oldsumm=();
    MAINLOOP: for(my $date=_make_date(time+3600); _cmp_date($startdate,$date)<=0; $date=_date_add($date,-1,0,0)){
        return 0 if $api->halting;
        my $title='Wikipedia:Deletion review/Log/'.$date->[2].' '.$months[$date->[1]].' '.$date->[0];

        $api->log("Checking DRVs in $title");
        my $tok=$api->edittoken($title);
        if($tok->{'code'} eq 'shutoff'){
            $api->warn("Task disabled: ".$tok->{'content'}."\n");
            return 300;
        }
        if($tok->{'code'} ne 'success'){
            $api->warn("Failed to get edit token for $title: ".$tok->{'error'}."\n");
            return 60;
        }
        my $intxt=$tok->{'revisions'}[0]{'slots'}{'main'}{'*'} // '';
        $intxt=~s/\s*$//;
        my $outtxt=$intxt;

        # Fix header if necessary
        my $fixedhead=0;
        my $pageheader=_makepagehead($date);
        if($outtxt!~/^\Q$pageheader\E/){
            my $oldtxt;
            do {
                $oldtxt=$outtxt;
                $outtxt=~s/^(?:|.*?\n)===$headerContents===[^\n]*?(?:\n|$)//s;
                $outtxt=~s/^\s*<!--.*?-->\s*//s;
                $outtxt=~s/^\s*//;
            } while($oldtxt ne $outtxt);
            $outtxt="$pageheader\n$outtxt";
            $outtxt=~s/\s*$//;
        }
        $fixedhead=($outtxt ne $intxt);

        # If the page has been edited in the last day, keep watching it in case
        # the last closing gets reverted.
        my $ts=ISO2timestamp($tok->{'revisions'}[0]{'timestamp'}) // time;
        $new_start=[@$date] if(time()-$ts<86400 && _cmp_date($date,$new_start)<0);

        # Remove headers if all discussions are closed and it has been
        # long enough since the last edit
        my $rmhead=0;
        if(time()-$ts>86400 && _cmp_date($date,$today)<0){
            my $txt=$outtxt;
            $txt=~s/\n====$headerContents====[^\n]*\n\s*($re)/ _rmsubhead($1) /ge;
            if($txt=~/\x02ERROR\x03/){
                $api->log("Crap, $title is b0rken");
                $api->warn("Crap, $title is b0rken\n");
                $api->whine("[[$title]] is broken", "Help! A section in [[$title]] seems to contain a level-4 header. Probably someone screwed up the wikitext created by {{tls|DRV top}} (which could make me think an entire discussion is part of <nowiki>{{{1}}} or {{{2}}}</nowiki>) or {{tls|DRV bottom}} (so I'm not finding the end of the discussion and running it together with the next one). Anyway, I can't remove the headers from that page until someone fixes it.");
            } elsif($txt ne $outtxt && $txt!~/\n====$headerContents====[^\n]*\n/){
                $rmhead=1;
                $outtxt=$txt;
            }
        }

        # If the headers weren't all removed, that means something is still
        # active. So make sure we don't drop it from scanning next time.
        if($outtxt=~/\n====$headerContents====[^\n]*\n/){
            $new_start=[@$date] if _cmp_date($date,$new_start)<0;
        }

        # Figure out where to put the page
        if(_cmp_date($date,$today)>0){
            # Future, don't list yet
        } elsif(_cmp_date($date,$today)==0){
            # Today, always list as active
            push @cur, "{{$title}}\n";
            unshift @cursumm, [@$date];
        } elsif(_cmp_date($date,$sevendays)>=0){
            # Last 7 days, list as active if not empty
            if($outtxt=~/\n====$headerContents====[^\n]*\n|$re/){
                push @cur, "{{$title}}\n";
                unshift @cursumm, [@$date];
            }
        } elsif(_cmp_date($date,$fortnight)>=0){
            # Last 14 days, list as recent if not empty
            if($outtxt=~/\n====$headerContents====[^\n]*\n|$re/){
                push @old, "{{$title}}\n";
                unshift @oldsumm, [@$date];
            }
        } else {
            # Older, list only if not closed
            if($outtxt=~/\n====$headerContents====[^\n]*\n/){
                push @old, "{{$title}}\n";
                unshift @oldsumm, [@$date];
            }
        }

        # Need to edit?
        next unless($fixedhead || $rmhead);

        # Create summary
        my @summary=();
        if($fixedhead){
            if(exists($tok->{'missing'})){
                push @summary, "new discussion page: ".$date->[2].' '.$months[$date->[1]].' '.$date->[0];
            } else {
                push @summary, "fix page header";
            }
        }
        push @summary, "remove section headers for closed log page" if $rmhead;
        my $summary='(BOT) '.ucfirst(join('; ', @summary)).".$screwup";
        $api->log("$summary in $title");
        my $r=$api->edit($tok, $outtxt, $summary, 0, 1);
        if($r->{'code'} ne 'success'){
            $api->warn("Write failed on $title: ".$r->{'error'}."\n");
            return 60;
        }
    }

    # Ok, we've processed all the subpages. Now update the lists of DRVs on
    # the main page.
    my $ret=$self->update_list($api, 'Recent', \@old, \@oldsumm);
    return $ret if $ret;
    $ret=$self->update_list($api, 'Active', \@cur, \@cursumm);
    return $ret if $ret;

    # Save checked revision
    $self->{'lasttime'}=$starttime;
    $self->{'broken'}=$broken;
    $api->store->{'startdate'}=$new_start;
    $api->store->{'lasttime'}=$starttime;
    $api->store->{'broken'}=$broken;

    # Check if the monthly log page needs creation too
    {
        my $date=_make_date(time+86400);
        my $title='Wikipedia:Deletion review/Log/'.$date->[2].' '.$months[$date->[1]];
        my $tok=$api->edittoken($title);
        if($tok->{'code'} eq 'shutoff'){
            $api->warn("Task disabled: ".$tok->{'content'}."\n");
            return 300;
        }
        if($tok->{'code'} ne 'success'){
            $api->warn("Failed to get edit token for $title: ".$tok->{'error'}."\n");
            return 60;
        }
        last unless exists($tok->{'missing'});
        my @days=();
        my $m=$date->[1];
        for($date=[1,$date->[1],$date->[2]]; $date->[1]==$m; $date=_date_add($date,1,0,0)){
            my $t=$title.' '.$date->[0];
            unshift @days, "{{#ifexist: $t | {{$t}} | }}";
        }
        my $outtxt="{{Wikipedia:Deletion review/Log/Header}}\n".join("\n", @days);
        my $r=$api->edit($tok, $outtxt, "Create monthly log page", 0, 1);
        if($r->{'code'} ne 'success'){
            $api->warn("Write failed on $title: ".$r->{'error'}."\n");
            return 60;
        }
    }

    return $starttime+($self->{'broken'}?300:3600)-time;
}

sub update_list {
    my ($self,$api,$page,$list,$summ)=@_;

    my $title="Wikipedia:Deletion review/$page";
    $api->log("Updating discussions lists on $title");
    my $tok=$api->edittoken($title);
    if($tok->{'code'} eq 'shutoff'){
        $api->warn("Task disabled: ".$tok->{'content'}."\n");
        return 300;
    }
    if($tok->{'code'} ne 'success'){
        $api->warn("Failed to get edit token for $title: ".$tok->{'error'}."\n");
        return 60;
    }
    if(exists($tok->{'missing'})){
        $api->warn("WTF? $title is missing!\n");
        return 60;
    }
    my $intxt=$tok->{'revisions'}[0]{'slots'}{'main'}{'*'};
    my $outtxt=$intxt;

    my $txt="\n==[[$title|$page discussions]]==\n";
    if(@$list){
        #$txt.="{{adminbacklog|bot=".$api->user."}}\n";
        $txt.=join('',@$list);
    } else {
        $txt.="* (None at this time)\n";
    }
    $txt.="\n";
    unless($outtxt=~s#\n== *\[\[Wikipedia:Deletion review\/\Q$page\E\|\Q$page\E discussions\]\] *==\s*\n.*#$txt#s){
        $api->log("Could not find discussions section in $title!");
        $api->warn("Could not find discussions section in $title!");
        return 60;
    }
   
    if($intxt ne $outtxt){
        my $summary;
        if(@$summ){
            my $m=0;
            my @summ=map {
                if($_->[1]!=$m){
                    $m=$_->[1];
                    $_=substr($months[$_->[1]],0,3).' '.$_->[0];
                } else {
                    $_=$_->[0];
                }
                $_
            } @$summ;
            $summ[-1].='.';
            $summary='(BOT) Updating discussions: '.join(', ', @summ).$screwup;
            $api->log("$summary in $title");
            $summary='(BOT) Updating discussions: major backlog!'.$screwup if length($summary)>500;
        } else {
            $summary='(BOT) Updating discussions: no old discussions'.$screwup;
        }
        my $r=$api->edit($tok, $outtxt, $summary, 0, 1);
        if($r->{'code'} ne 'success'){
            $api->warn("Write failed on $title: ".$r->{'error'}."\n");
            return 60;
        }
    }

    return 0;
}

sub _make_date {
    my $t=shift || time;
    if(ref($t) eq 'ARRAY'){
        return _fix_date([@$t]);
    } else {
        my @t=gmtime($t);
        @t=@t[3..5];
        $t[1]+=1;
        $t[2]+=1900;
        return [@t];
    }
}

sub _date_add {
    my @t=@{$_[0]};
    $t[0]+=$_[1];
    $t[1]+=$_[2];
    $t[2]+=$_[3];
    return _fix_date([@t]);
}

sub _fix_date {
    my $t=shift;
    my @t=gmtime(timegm(0,0,0,$t->[0],$t->[1]-1,$t->[2]-1900));
    @t=@t[3..5];
    $t[1]+=1;
    $t[2]+=1900;
    return [@t];
}

sub _cmp_date {
    my $a=shift;
    my $b=shift;
    my $x;

    $x=$a->[2]-$b->[2];
    $x=$a->[1]-$b->[1] if $x==0;
    $x=$a->[0]-$b->[0] if $x==0;
    return $x;
}

sub _makepagehead {
    my $date=shift;
    return '<noinclude>{{Deletion review log header}}</noinclude>
'.'===[[Wikipedia:Deletion review/Log/'.$date->[2].' '.$months[$date->[1]].' '.$date->[0].'|'.$date->[0].' '.$months[$date->[1]].' '.$date->[2].']]===
<!--Please notify the administrator who performed the action that you wish to be reviewed by leaving {{subst:DRVNote|page name}} on their talk page.

Add a new entry BELOW THIS LINE copying the format: {{subst:drv2|page=<PAGE NAME>|xfd_page=<XFD PAGE NAME>|reason=<REASON>}} ~~~~      -->
';
}

sub _va {
    my $txt=shift;
    $txt=~s/\|/{{!}}/g;
    return "\n'''{{visible anchor|$txt}}'''\n";
}

sub _rmsubhead {
    my $txt=shift;
    return "\x02ERROR\x03" if $txt=~/\n====$headerContents====[^\n]*\n/;
    $txt=~s/\n====+\s*+($headerContents(?<!\s)|)\s*====+[^\n]*\n/ _va($1) /ge;
    return "\n$txt";
}

1;