User:AnomieBOT/source/tasks/DeletionSortingCleaner.pm: Difference between revisions

Revision as of 12:14, 17 September 2024

Latest revision as of 17:11, 22 August 2025

(4 intermediate revisions by the same user not shown)

Line 1:

{{ombox|type=notice|text= Approved 2010-07-06<br />[[Wikipedia:Bots/Requests for approval/AnomieBOT 40]]}}

{{ombox|type=notice|text= Supplemental BFRA approved 2020-06-06<br />[[Wikipedia:Bots/Requests for approval/AnomieBOT 79]]}}

{{ombox|type=notice|text= Supplemental BFRA approved 2025-08-22<br />[[Wikipedia:Bots/Requests for approval/AnomieBOT 85]]}}

<syntaxhighlight lang="perl">

package tasks::DeletionSortingCleaner;

Line 14 ⟶ 15:

+BRFA: Wikipedia:Bots/Requests for approval/AnomieBOT 79

+Status: Approved 2020-06-06

+BRFA: Wikipedia:Bots/Requests for approval/AnomieBOT 85

+Status: Approved 2025-08-22

Created: 2010-06-18

Line 20 ⟶ 23:

* Archive discussions for closed XfDs

* Remove duplicate XfD listings

* Remove deleted XfD listings

If necessary, the bot may be kept off a deletion sorting subpage by adding

Line 55 ⟶ 59:

=for info

Supplemental BFRA approved 2020-06-06<br />[[Wikipedia:Bots/Requests for approval/AnomieBOT 79]]

=for info

Supplemental BFRA approved 2025-08-22<br />[[Wikipedia:Bots/Requests for approval/AnomieBOT 85]]

=cut

Line 92 ⟶ 99:

# Load list of deletion sorting subpages to process

if ( ! defined( $self->{'pages'} ) ) {

$res=$api->query(titles=>'Wikipedia:WikiProject Deletion sorting/CompactComputer-readable.json',prop=>'linksrevisions',plnamespacervprop=>4"content",pllimitrvslots=>'max'"main",rvlimit=>1,formatversion=>2);

if($res->{'code'} ne 'success'){

$api->warn("Failed to get list of pages to process: ".$res->{'error'}."\n");

return 60;

}

my $json;

$self->{'pages'}=[ sort grep m!^Wikipedia:WikiProject Deletion sorting/!, map $_->{'title'}, @{(values %{$res->{'query'}{'pages'}})[0]{'links'}} ];

eval { $json = JSON->new->decode( $res->{'query'}{'pages'}[0]{'revisions'}[0]{'slots'}{'main'}{'content'} // '' ); };

if ( $@ ) {

$api->warn("Failed to parse Wikipedia:WikiProject Deletion sorting/Computer-readable.json: $@\n");

return 300;

}

my %pages = ();

for my $g (values %$json) {

for my $p (@$g) {

$pages{"Wikipedia:WikiProject Deletion sorting/$p"} = 1;

}

}

$self->{'pages'}=[ sort keys %pages ];

unless(@{$self->{'pages'}}){

$api->warn("No pages in list?");

Line 138 ⟶ 157:

my $dups=0;

my %dups=();

my $deleted=0;

my $outtxt=$api->process_templates($intxt, sub {

return undef if defined($fail);

my $name=shift;

shift; # $params

my $wikitext=shift;

return undef unless $name=~m!^(?i:Wikipedia|WP) *: *((?:[Aa]rticles|[Mm]iscellany) for deletion)/(.+)$!;

Line 182 ⟶ 204:

}

if(exists($xfdtok->{'missing'})){

# WTF?Check for a deletion log entry.

my $res2 = $api->query(

letitle => $name,

list => 'logevents',

letype => 'delete',

lelimit => 1,

leprop => 'user|timestamp|comment',

);

if($res2->{'code'} ne 'success'){

$api->warn("Failed to retrieve logs for $name: " . $res2->{'error'} . "\n");

$fail = 60;

return undef;

}

if(exists($res2->{'query'}{'logevents'}[0])){

my $log = $res2->{'query'}{'logevents'}[0];

# Check whether the deletion log entry could reasonably

# belong to this listing.

my %q = (

titles => $page,

prop => 'revisions',

rvprop => 'ids|timestamp|content',

rvslots => 'main',

rvlimit => 10,

formatversion => 2,

);

my %cont = ();

my $wt = $wikitext;

do {

my $res3 = $api->query( %q );

if($res3->{'code'} ne 'success'){

$api->warn("Failed to retrieve revisions for $page: " . $res3->{'error'} . "\n");

$fail = 60;

return undef;

}

for my $rev (@{$res3->{'query'}{'pages'}[0]{'revisions'}}) {

next unless exists( $rev->{'slots'}{'main'}{'content'} ); # Revdel?

my $c = $rev->{'slots'}{'main'}{'content'};

my $found = ( $c =~ /\Q$wt\E/ );

if ( ! $found ) {

$api->process_templates($c, sub {

return undef if $found;

my $name2=shift;

shift; # $params

my $wikitext2=shift;

return undef unless $name2=~m!^(?i:Wikipedia|WP) *: *((?:[Aa]rticles|[Mm]iscellany) for deletion)/(.+)$!;

# Normalize. People do weird things sometimes.

$name2 = "Wikipedia:\u$1/$2";

if ( $name2 eq $name ) {

$wt = $wikitext2;

$found = 1;

}

return undef;

});

}

if ( ! $found ) {

$api->warn("XfD page $name linked from $page does not exist, deleted at $log->{'timestamp'} but newer rev $rev->{'revid'} from $rev->{'timestamp'} did not transclude it.\n");

return undef;

}

if ( $rev->{'timestamp'} le $log->{'timestamp'} ) {

$res3->{'continue'} = {};

last;

}

}

%cont = %{ $res3->{'continue'} // {} };

} while ( %cont );

# Deleted since it was listed, so remove from page.

$deleted=1;

push @summary, "[[$name]] (was deleted)";

return '';

}

$api->warn("XfD page $name linked from $page does not exist\n");

return undef;

Line 296 ⟶ 393:

if($outtxt ne $intxt){

$api->log("Archiving closed XfDs and/or removing duplicates from $page...");

my $what = '';

$what .= "[[$apage|Archiving closed XfDs]]" if @archive;

$what .= ( @archive ? ' and removing' : 'Removing' ) . ( $deleted ? ' deleted' : '' ) . ( $dups ? ( $deleted ? ' and duplicate' : ' duplicate' ) : '' ) . ' XfDs' if $deleted || $dups;

my $summary;

if$summary=$what . $screwup . ": " . join(" ", @summary){;

$summary="[[$apage|Archiving closed XfDs]]"what . ( $dupsscrewup ? ' and removing duplicate XfDs'. ": '' )[" . $screwupscalar(@summary) . ": discussions]" .if joinlength(" ", @$summary)>500;

$summary="[[$apage|Archiving closed XfDs]]" . ( $dups ? ' and removing duplicate XfDs' : '' ) . $screwup . ": [" . scalar(@summary) . " discussions]" if length($summary)>500;

} else {

$summary = "Removing duplicate XfDs" . $screwup;

}

$res=$api->edit($tok, $outtxt, $summary, 0, 1);

if($res->{'code'} ne 'success'){