User:AnomieBOT/source/tasks/CFDClerk.pm

. That's too confusing for me to handle. I'm not going to process any CFDs until it's fixed or I'm fixed.");                   return 300;                }                if($p1 =~ m/\{\{\{/ || $p2 =~ m/\{\{\{/ ){                    $api->whine("Template:Cfd top is broken", "Help! The template cfd top contains unknown parameters. To avoid confusion, I'm not going to process any CFDs until it's fixed or I'm fixed.");                   return 300;                }

my $tag = $api->get_token_for( $wikitext ); $p1 = $api->replace_stripped( myquotemeta( $p1 ), \%substedIfs ); $p2 = $api->replace_stripped( myquotemeta( $p2 ), \%substedIfs ); $substedIfs{$tag} = '(?:' . $p1 . '|' . $p2 . ')'; return $tag; }           return undef; } );       unless($t =~ m/^\s*$is_closed_re/){            next unless $first;            $api->whine("Template:Cfd top is broken", "Help! The template cfd top is missing the \"is_closed\" regex, or this regex is not at the beginning of the template's output. To avoid confusion, I'm not going to process any CFDs until it's fixed or I'm fixed.");            return 300;        }        if($t =~ m/\x07\s*$/){            next unless $first;            $api->whine("Template:Cfd top is broken", "Help! The template cfd top does not end with some constant text, i.e.  is at the very end of the template. To avoid confusion, I'm not going to process any CFDs until it's fixed or I'm fixed.");            return 300;        }        if($t =~ m/\{\{\{/){            next unless $first;            $api->whine("Template:Cfd top is broken", "Help! The template cfd top contains unknown parameters. To avoid confusion, I'm not going to process any CFDs until it's fixed or I'm fixed.");           return 300;        }        $t=myquotemeta($t);        $t = $api->replace_stripped( $t, \%substedIfs );        $t=~s/\\\x07/(?s:.*?)/g;        $re.="|$t";        $first = 0;    }

# Get the content of all versions of "cfd relisted" since the startdate my $relisted_re='\{\{\s*[cC]fd[ _]?relisted\s*(?s:\|.*?)?\}\}'; %cont=; $first=1; while($first || %cont) { my $t=$api->query(           titles  => 'Template:cfd relisted',            prop    => 'revisions',            rvprop  => 'timestamp|content',            rvslots => 'main',            rvlimit => 1,            %cont,        ); if($t->{'code'} ne 'success'){ $api->warn("Failed to load revisions for Template:cfd 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! .* !!gs; $t=~s!!!g; $t=~s!\Q\E!\x07!g; while ( $t=~m!(\{\{\{\{\{\|safesubst:\}\}\}require subst\s*\|(.*?)\s*\}\})!s ) { my ($old,$new) = ($1,$2); # strips comments. Sigh. $new =~ s///gs; $t=~s!\Q$old\E!$new!; }       if($t =~ m/\x07\s*$/){ next unless $first; $api->whine("Template:Cfd relisted is broken", "Help! The template cfd relisted does not end with some constant text, i.e. is at the very end of the template. To avoid confusion, I'm not going to process any CFDs until it's fixed or I'm fixed."); return 300; }       if($t =~ m/\{\{\{/){ next unless $first; $api->whine("Template:Cfd relisted is broken", "Help! The template cfd relisted contains unknown parameters. To avoid confusion, I'm not going to process any CFDs until it's fixed or I'm fixed."); return 300; }       $t=quotemeta($t); $t=~s/\\\x07/(?s:.*?)/g; $relisted_re.="|$t"; $first = 0; }

# Iterate over all our pages my $broken=0; my $new_start=_make_date; my $today=_make_date; my $sevendays=_date_add(_make_date,-7,0,0); my @old=; my @oldsumm=; my @oldlinks=; 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:Categories for discussion/Log/'.$date->[2].' '.$months[$date->[1]].' '.$date->[0];

$api->log("Checking CFDs 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'}{'*'} // ''; my $outtxt=$intxt;

# Fix header if necessary my $iscur = _cmp_date($date,$today) >= 0; my $fixedhead=0; my ($pageheader,$err)=_makepagehead($api, $title, $date, $iscur); if ( ! defined( $pageheader ) ) { $api->warn("Failed to get page header for $title: $err\n"); return 60; }       if($outtxt!~/^\Q$pageheader\E/){ my $dt=$months[$date->[1]].' '.$date->[0]; my $oldtxt; do { $oldtxt=$outtxt; $outtxt=~s/^(?:|.*?\n)===\s*\Q$dt\E\s*===[^\n]*(?:\n|$)//s; $outtxt=~s/^\s*\s*//s; $outtxt=~s/^\s*====[ \t]*NEW NOMINATIONS[ \t]*====\s*(?:\n|$)//s; $outtxt=~s/^\s*\s*//s; $outtxt=~s/^\s*//; } while($oldtxt ne $outtxt); $outtxt="$pageheader\n$outtxt"; }       if ( $iscur ) { $outtxt .= "\n" unless $outtxt=~/\n\s*$/; } else { $outtxt =~ s/\s*\n====[ \t]*NEW NOMINATIONS[ \t]*====\s*\n/\n/; $outtxt =~ s/\s*\n\s*\s*\n/\n/; $outtxt =~ s/\s*\n\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);

# Fix any simple mispositioned headers: armor any good headers, then # fix any mispositioned ones, then unarmor. my ($marker, $i)=('', 0); do { $marker = "\x02--$i--\x03"; $i++; } while($outtxt=~/$marker/); $outtxt=~s/(?:^|(?<=\n))((====+)[^=](?:.*[^=])?\2\s*?\n\s*$noticere*$is_closed_re)/$1$marker/g; my $fixed=($outtxt=~s/(?:^|(?<=\n))((?>$re).*\n)\s*((====+)[^=](?:.*[^=])?\3\s*?\n)/$2$1/g); $outtxt=~s/$marker//g;

# Split into level-4+ sections, and check if each is closed my @sections=$api->split_sections($outtxt, "456"); my $ct=0; my @secs=; my @closed=; my @pageoldlinks=; for(my $i=0; $i<@sections; $i++){ my $s=$sections[$i];

next if $s->{'body'}=~m/^\s*/;

if($s->{'body'}=~m/^\s*$noticere*$is_closed_re/ || $s->{'body'}=~m/^\s*$relisted_re\s*$/){ # Someone closed a section, so merge in all its subsections my $j; for($j=$i+1; $j<@sections && $sections[$j]->{'level'} > $s->{'level'}; $j++){} if($j>$i+1){ $s->{'body'}=~s/\s*$/\n\n/; $s->{'body'}.=$api->join_sections(splice(@sections, $i+1, $j-$i-1)); }           }

$_=$s->{'body'};

my $bad=/(?>^\s*$noticere*\S).*$is_closed_re/s; next if !$bad && ( m/^\s*$noticere*$is_closed_re/ || $s->{'body'}=~m/^\s*$relisted_re\s*$/ ); if($bad || /$is_closed_re/s){ $api->log("Crap, \[\[$title#$s->{title}\]\] is b0rken"); $api->warn("Crap, $title is b0rken\n"); $api->whine("$title is broken", "Help! A section in $title contains the \"is_closed\" regex but not at the beginning of the section. Probably someone put the cfd top before a section header instead of after. Anyway, I can't do anything to that page until someone fixes it."); if(_cmp_date($date,$sevendays)<0){ push @old, "* $title (broken)\n"; unshift @oldsumm, [@$date]; push @oldlinks, "* $title is broken\n"; }               $new_start=[@$date]; $broken=1; next MAINLOOP; }           next unless defined($s->{'level'}); $ct++; push @secs, [ $s ]; }       next if($ct==0 && @closed==0 && !$fixedhead && !$fixed);

# Now check the discussions to determine if all are closed. foreach my $sec (@secs){ my @cats=@$sec; my $s = shift @cats; my $ok=0; unless ( $ok ) { push @pageoldlinks, "* $title\n"; next; }       }

# Mark for entry on the list of old CFDs, if applicable if($ct>0){ if(_cmp_date($date,$sevendays)<0){ push @old, "* $title ($ct open)\n"; unshift @oldsumm, [@$date]; }           $new_start=[@$date]; }

if(_cmp_date($date,$sevendays)<0){ push @oldlinks, @pageoldlinks; }

# Need to edit? next unless(@closed || $fixed || $fixedhead);

# Processed, now reconstruct the page $outtxt=$api->join_sections(@sections);

# Subst templates, if necessary my $subst=0; $outtxt=$api->process_templates($outtxt, sub {           my $name=shift;            shift; #$params            my $wikitext=shift;

return undef unless exists($tosubst{"Template:$name"}); $subst++; $wikitext=~s/^\{\{\s*/\{\{subst:/; return $wikitext; });

# 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, "subst  and/or " if $subst>0; push @summary, 'move closing box'.(($fixed>1)?'es':'').' per WP:DPR' if $fixed; my $toomany=@summary; push @summary, 'close discussions for deleted/nonexistent categories: '.join(', ', @closed) if @closed; my $summary='(BOT) '.ucfirst(join('; ', @summary)).".$screwup"; $api->log("$summary in $title"); if(length($summary)>500){ $summary[$toomany]='close discussions for deleted/nonexistent categories: [too many to list]' if @closed; $summary='(BOT) '.ucfirst(join('; ', @summary)).$screwup; }

# Sanity check for whitespace-only edits my ($intxtSpace, $outtxtSpace) = ( $intxt, $outtxt ); $intxtSpace =~ s/\s*\n\s*/\n/g; $intxtSpace =~ s/[ \t]+/ /g; $intxtSpace =~ s/\s*$//g; $outtxtSpace =~ s/\s*\n\s*/\n/g; $outtxtSpace =~ s/[ \t]+/ /g; $outtxtSpace =~ s/\s*$//g; if ( $intxtSpace eq $outtxtSpace ) { #$api->log( "Skipping edit to $title because it seems to be whitespace-only: $summary" ); next; }

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 list of links to old # unclosed discussions. if ( 1 ) { my $title='Wikipedia:Categories for discussion/Old unclosed discussions'; $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; }       my $intxt=$tok->{'revisions'}[0]{'slots'}{'main'}{'*'} // ''; $intxt=~s/Last updated .*?/Last updated /; $intxt=~s/\s*$/\n/; my $outtxt="This is a list of unclosed CfDs over 7 days old. It is automatically maintained by a bot, but humans are free to remove lines when closing discussions if they'd like. Last updated .\n\n"; if ( @oldlinks ) { $outtxt .= join( '', @oldlinks ); } else { $outtxt .= "* None at this time\n"; }       if($intxt ne $outtxt){ my $summary; if(@oldsumm){ my $m=0; my @oldsumm2=map { my $ret; if($_->[1]!=$m){ $m=$_->[1]; $ret=substr($months[$_->[1]],0,3).' '.$_->[0]; } else { $ret=$_->[0]; }                   $ret } @oldsumm; $oldsumm2[-1].='.'; $summary='(BOT) Updating discussions: '.join(', ', @oldsumm2).$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; }       }    }

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

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

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 $api = shift; my $title = shift; my $date = shift; my $iscur = shift;

my $res = $api->query(       action => 'parse',        title => $title,        text =>  . $date->[2] . ,        onlypst => 1,        formatversion => 2,    ); return ( undef, $res->{'error'} ) if $res->{'code'} ne 'success';

my $txt = $res->{'parse'}{'text'}; $txt =~ s/\n\s*\s*$/\n/s;

if ( ! $iscur ) { $txt =~ s/\n\s*\s*$/\n/s; $txt =~ s/\n====[ \t]*NEW NOMINATIONS[ \t]*====\s*$/\n/s; $txt =~ s/\s*$/\n/s; }

return ($txt, undef); }

1;