5 use Set
::Object
'&set';
7 my $delay_between_edits = 60; # In seconds.
8 my $delay_between_edit_tries = 5;
9 # Also in seconds. This is the delay taken before trying again
10 # when an edit fails because of an edit conflict.
12 my $username = 'UnderBot';
13 my $password = 'secret';
15 my $kill_switch_page = 'User talk:UnderBot';
16 my $kill_switch_trigger = qr/stopediting/i;
18 my $api_url = 'http://rosettacode.org/mw/api.php';
20 # ------------------------------------------------------------
24 {use parent
'MediaWiki::API';
26 my $se = {skip_encoding
=> 1};
33 '. (', $self->{error}->{code}, ': ',
34 $self->{error}->{details}, ".)\n";}
38 $self->SUPER::list({@_}, $se);}
41 # Returns the titles of all the pages in the given category.
42 {my ($self, $cat) = @_;
43 map {$_->{title}} @{$self->list
45 list => 'categorymembers
',
48 or $self->couldnt(qq(get members of "$cat"))};}
51 # Gets the given page with the given title.
52 {my ($self, $title) = @_;
53 $self->get_page({title => $title})
54 or $self->couldnt(q(fetch "$title".));}
57 # Has a page with this title ever been deleted?
58 {my ($self, $title) = @_;
59 return !! @{$self->list
66 # Returns false iff the edit wasn't made because of an edit
67 # conflict. However, edit conflicts are only checked for if
68 # appropriate %args are supplied.
69 {my ($self, $title, %args) = @_;
70 # Don't touch this page if one by this name has been
72 if ($self->has_been_deleted($title))
73 {print "Didn't edit previously deleted page: $title\n";
76 my $response = $self->SUPER::edit
83 {if ($self->{error
}->{details
} =~ /\Aeditconflict/)
84 {print "Edit conflict: $title\n";
86 $self->couldnt(sprintf 'edit page "%s" (%s)',
87 $title, join(', ', %args));}
89 ($args{summary
} ?
" ($args{summary})" : ''),
91 # Now sleep for a bit and check the kill switch.
92 sleep $delay_between_edits;
93 $self->fetch($kill_switch_page)->{'*'} =~ $kill_switch_trigger
98 # A way to edit a page that guards against edit conflicts.
99 # $function should modify $_ (which will contain the
100 # text of the page) and return the edit summary.
101 {my ($self, $title, $function) = @_;
103 {my $page = $self->fetch($title);
104 my $timestamp = $page->{timestamp
} || 0;
105 my $text = $page->{'*'};
107 my $summary = $function->();
108 $self->edit_page($title,
111 basetimestamp
=> $timestamp)
113 sleep $delay_between_edit_tries;}}}
117 # ------------------------------------------------------------
121 binmode STDOUT
, ':utf8';
122 print 'Starting: ', scalar localtime, "\n";
124 my $mw = new MW
({api_url
=> $api_url});
126 $mw->login({lgname
=> $username, lgpassword
=> $password})
127 or $mw->couldnt('log in');
129 # Get existing languages.
132 grep {$_ ne 'HQ9+'} # Hardly a real language.
133 map {/Category:(.+)/ ?
$1 : ()}
134 $mw->category('Category:Programming Languages');
136 # Add any new languages that Rosetta Coders have used as arguments
137 # to Template:Mylang.
140 grep {$_->{type
} eq 'edit' or $_->{type
} eq 'new'}
141 # We don't care about log entries, deletions, etc.
144 list
=> 'recentchanges',
145 rcnamespace
=> 2, # User
147 or $mw->couldnt('get recent changes');
149 foreach my $u (@users)
150 {my $p = $mw->fetch($u);
151 exists $p->{'*'} or next;
152 foreach ($p->{'*'} =~ /{{mylang\|(.+?)\|/g)
154 $langs->has($_) || m/#/ and next;
155 # Nasty things happen if we try to create a page with
156 # a pound sign in its title.
157 $mw->edit_page("Category:$_",
158 appendtext
=> '{{language}}{{stub}}',
159 summary
=> "Created language observed in [[$u]].");
160 $langs->insert($_);}}
162 # Create language-user, not-implemented,
163 # examples-needing-attention, and language-implementation pages.
166 (['Category:Language users',
169 ['Category:Unimplemented tasks by language',
170 'Reports:Tasks not implemented in %s',
171 '{{Unimpl Page|%s}}'],
172 ['Category:Examples needing attention',
173 'Category:%s examples needing attention',
174 '{{enacat body|%s}}'],
175 ['Category:Language Implementations',
176 'Category:%s Implementations',
177 '{{implementation cat|%s}}'])
178 {my ($cat, $title_fmt, $body_fmt) = @
$_;
179 (my $r = quotemeta $title_fmt) =~ s/\\%s/(.+)/;
181 map {/\A$r\z/ ?
$1 : ()}
184 foreach (@
{$langs - $catlangs}) # Set difference
185 {$mw->edit_page(sprintf($title_fmt, $_),
186 appendtext
=> sprintf($body_fmt, $_));}}
188 #my ($a, $b) = (-1, -1);
189 #while (++$a < @langs and ++$b < @catlangs)
190 # {$langs[$a] eq $catlangs[$b] and next;
191 # if ($catlangs[$b] lt $langs[$a])
194 # $create->($langs[$a]);
196 # $create->($_) foreach @langs[$a .. $#langs];}
198 # For each category C in Category:Alternate_language_names, move
199 # all members of C to the redirect target named in the page for C.
200 # We assume that the members of C are included in C via
201 # Template:Header, as opposed to an explicit wikilink to C.
203 foreach my $cat ($mw->category('Category:Alternate language names'))
204 {my $catpage = $mw->fetch($cat)->{'*'};
205 $catpage =~ /#REDIRECT\s+\[\[:?Category:(.+?)\]\]/
206 or die "Regex didn't match in $cat";
208 my $alt = quotemeta substr $cat, length 'Category:';
209 # We'll be using $alt as a regex. It should permit underscores
210 # in place of spaces, since MediaWiki does.
212 foreach my $task ($mw->category($cat))
213 {$mw->modify_page($task, sub
214 {s
<== \
{\
{ header \
| ($alt) ([|}])>
215 <=={{header
|$target$2>xg
216 or print "Failed to remove $task from $cat.\n";
217 qq("header|$1" -> "header|$target");});}}
221 print 'Done: ', scalar localtime, "\n";