File Coverage

blib/lib/MediaWiki/Bot.pm
Criterion Covered Total %
statement 807 1099 73.4
branch 310 598 51.8
condition 65 172 37.7
subroutine 66 78 84.6
pod 58 58 100.0
total 1306 2005 65.1


line stmt bran cond sub pod time code
1             package MediaWiki::Bot;
2 50     50   1808938 use strict;
  50         126  
  50         2923  
3 50     50   301 use warnings;
  50         182  
  50         2884  
4             # ABSTRACT: a high-level bot framework for interacting with MediaWiki wikis
5             our $VERSION = '5.006000'; # VERSION
6              
7 50     50   53581 use HTML::Entities 3.28;
  50         477474  
  50         6183  
8 50     50   583 use Carp;
  50         165  
  50         4655  
9 50     50   409 use Digest::MD5 2.39 qw(md5_hex);
  50         1673  
  50         3225  
10 50     50   69865 use Encode qw(encode_utf8);
  50         914555  
  50         6364  
11 50     50   70709 use MediaWiki::API 0.36;
  50         5097737  
  50         6761  
12 50     50   639 use List::Util qw(sum);
  50         120  
  50         7998  
13 50     50   42368 use MediaWiki::Bot::Constants qw(:all);
  50         152  
  50         14050  
14              
15 50     50   304 use Exporter qw(import);
  50         94  
  50         4489  
16             our @EXPORT_OK = @{ $MediaWiki::Bot::Constants::EXPORT_TAGS{all} };
17             our %EXPORT_TAGS = ( constants => \@EXPORT_OK );
18              
19 50     50   79523 use Module::Pluggable search_path => [qw(MediaWiki::Bot::Plugin)], 'require' => 1;
  50         772606  
  50         423  
20             foreach my $plugin (__PACKAGE__->plugins) {
21             #print "Found plugin $plugin\n";
22             $plugin->import();
23             }
24              
25              
26             sub new {
27 47     47 1 15237 my $package = shift;
28 47         109 my $agent;
29             my $assert;
30 0         0 my $operator;
31 0         0 my $maxlag;
32 0         0 my $protocol;
33 0         0 my $host;
34 0         0 my $path;
35 0         0 my $login_data;
36 0         0 my $debug;
37              
38 47 50       234 if (ref $_[0] eq 'HASH') {
39 47         146 $agent = $_[0]->{agent};
40 47         137 $assert = $_[0]->{assert};
41 47         118 $operator = $_[0]->{operator};
42 47         104 $maxlag = $_[0]->{maxlag};
43 47         113 $protocol = $_[0]->{protocol};
44 47         113 $host = $_[0]->{host};
45 47         97 $path = $_[0]->{path};
46 47         107 $login_data = $_[0]->{login_data};
47 47         178 $debug = $_[0]->{debug};
48             }
49             else {
50 0 0       0 warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
51             . 'the constructor is deprecated and will be removed in a future release')
52             if @_;
53 0         0 $agent = shift;
54 0         0 $assert = shift;
55 0         0 $operator = shift;
56 0         0 $maxlag = shift;
57 0         0 $protocol = shift;
58 0         0 $host = shift;
59 0         0 $path = shift;
60 0         0 $debug = shift;
61             }
62              
63 47 100       180 $assert =~ s/[&?]assert=// if $assert; # Strip out param part, leaving just the value
64 47 100       165 $operator =~ s/^User://i if $operator;
65              
66 47 50 66     566 if (not $agent and not $operator) {
    100 66        
67 0         0 carp q{You should provide either a customized user agent string }
68             . q{(see https://meta.wikimedia.org/wiki/User-agent_policy) }
69             . q{or provide your username as `operator'.};
70             }
71             elsif (not $agent and $operator) {
72 3         7 $operator =~ s{^User:}{};
73 3 50       72 $agent = sprintf(
74             'Perl MediaWiki::Bot/%s (%s; [[User:%s]])',
75             (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'),
76             'https://metacpan.org/MediaWiki::Bot',
77             $operator
78             );
79             }
80              
81 47         168 my $self = bless({}, $package);
82 47         364 $self->{errstr} = '';
83 47 100       175 $self->{assert} = $assert if $assert;
84 47         112 $self->{operator} = $operator;
85 47   50     355 $self->{debug} = $debug || 0;
86 47 50       756 $self->{api} = MediaWiki::API->new({
87             max_lag => (defined $maxlag ? $maxlag : 5),
88             max_lag_delay => 5,
89             max_lag_retries => 5,
90             retries => 5,
91             retry_delay => 10, # no infinite loops
92             use_http_get => 1, # use HTTP GET to make certain requests cacheable
93             });
94 47 50       921429 $self->{api}->{ua}->agent($agent) if defined $agent;
95              
96             # Set wiki (handles setting $self->{host} etc)
97 47         3959 $self->set_wiki({
98             protocol => $protocol,
99             host => $host,
100             path => $path,
101             });
102              
103             # Log-in, and maybe autoconfigure
104 47 50       211 if ($login_data) {
105 0         0 my $success = $self->login($login_data);
106 0 0       0 if ($success) {
107 0         0 return $self;
108             }
109             else {
110 0 0       0 carp "Couldn't log in with supplied settings" if $self->{debug};
111 0         0 return;
112             }
113             }
114              
115 47         265 return $self;
116             }
117              
118              
119             sub set_wiki {
120 47     47 1 136 my $self = shift;
121 47         104 my $host;
122             my $path;
123 0         0 my $protocol;
124              
125 47 50       350 if (ref $_[0] eq 'HASH') {
126 47         160 $host = $_[0]->{host};
127 47         140 $path = $_[0]->{path};
128 47         130 $protocol = $_[0]->{protocol};
129             }
130             else {
131 0         0 warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
132             . 'set_wiki is deprecated, and will be removed in a future release');
133 0         0 $host = shift;
134 0         0 $path = shift;
135             }
136              
137             # Set defaults
138 47 100 50     744 $protocol = $self->{protocol} || 'http' unless defined($protocol);
139 47 100 50     303 $host = $self->{host} || 'en.wikipedia.org' unless defined($host);
140 47 100 50     567 $path = $self->{path} || 'w' unless defined($path);
141              
142             # Clean up the parts we will build a URL with
143 47         246 $protocol =~ s,://$,,;
144 47 50 33     311 if ($host =~ m,^(http|https)(://)?, && !$protocol) {
145 0         0 $protocol = $1;
146             }
147 47         131 $host =~ s,^https?://,,;
148 47         127 $host =~ s,/$,,;
149 47         130 $path =~ s,/$,,;
150              
151             # Invalidate wiki-specific cached data
152 47 50 33     973 if ( ((defined($self->{host})) and ($self->{host} ne $host))
      33        
      33        
      33        
      33        
153             or ((defined($self->{path})) and ($self->{path} ne $path))
154             or ((defined($self->{protocol})) and ($self->{protocol} ne $protocol))
155             ) {
156 0 0       0 delete $self->{ns_data} if $self->{ns_data};
157 0 0       0 delete $self->{ns_alias_data} if $self->{ns_alias_data};
158             }
159              
160 47         176 $self->{protocol} = $protocol;
161 47         129 $self->{host} = $host;
162 47         134 $self->{path} = $path;
163              
164 47 100       450 $self->{api}->{config}->{api_url} = $path
165             ? "$protocol://$host/$path/api.php"
166             : "$protocol://$host/api.php"; # $path is '', so don't use http://domain.com//api.php
167 47 50       228 warn "Wiki set to " . $self->{api}->{config}{api_url} . "\n" if $self->{debug} > 1;
168              
169 47         152 return RET_TRUE;
170             }
171              
172              
173             sub login {
174 1     1 1 11 my $self = shift;
175 1         2 my $username;
176             my $password;
177 0         0 my $lgdomain;
178 0         0 my $autoconfig;
179 0         0 my $basic_auth;
180 0         0 my $do_sul;
181 1 50       5 if (ref $_[0] eq 'HASH') {
182 1         4 $username = $_[0]->{username};
183 1         4 $password = $_[0]->{password};
184 1 50       6 $autoconfig = defined($_[0]->{autoconfig}) ? $_[0]->{autoconfig} : 1;
185 1         3 $basic_auth = $_[0]->{basic_auth};
186 1   50     6 $do_sul = $_[0]->{do_sul} || 0;
187 1         2 $lgdomain = $_[0]->{lgdomain};
188             }
189             else {
190 0         0 warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
191             . 'login is deprecated and will be removed in a future release');
192 0         0 $username = shift;
193 0         0 $password = shift;
194 0         0 $autoconfig = 0;
195 0         0 $do_sul = 0;
196             }
197 1         3 $self->{username} = $username; # Remember who we are
198              
199             # Handle basic auth first, if needed
200 1 50       12 if ($basic_auth) {
201 0 0       0 warn 'Applying basic auth credentials' if $self->{debug} > 1;
202 0         0 $self->{api}->{ua}->credentials(
203             $basic_auth->{netloc},
204             $basic_auth->{realm},
205             $basic_auth->{uname},
206             $basic_auth->{pass}
207             );
208             }
209              
210 1 50       5 if ($self->{host} eq 'secure.wikimedia.org') {
211 0         0 warnings::warnif('deprecated', 'SSL is now supported on the main Wikimedia Foundation sites. '
212             . 'Use en.wikipedia.org (or whatever) instead of secure.wikimedia.org.');
213 0         0 return;
214             }
215              
216 1 50       3 if($do_sul) {
217 0         0 my $sul_success = $self->_do_sul($password);
218 0 0 0     0 warn 'Some or all SUL logins failed' if $self->{debug} > 1 and !$sul_success;
219             }
220              
221 1         5 my $cookies = ".mediawiki-bot-$username-cookies";
222 1 50       21 if (-r $cookies) {
223 1         6 $self->{api}->{ua}->{cookie_jar}->load($cookies);
224 1         89 $self->{api}->{ua}->{cookie_jar}->{ignore_discard} = 1;
225             # $self->{api}->{ua}->add_handler("request_send", sub { shift->dump; return });
226              
227 1 50       5 if ($self->_is_loggedin()) {
228 0 0       0 $self->_do_autoconfig() if $autoconfig;
229 0 0       0 warn 'Logged in successfully with cookies' if $self->{debug} > 1;
230 0         0 return 1; # If we're already logged in, nothing more is needed
231             }
232             }
233              
234 1 50       4 unless ($password) {
235 0 0       0 carp q{Cookies didn't get us logged in, and no password to continue with authentication} if $self->{debug};
236 0         0 return;
237             }
238              
239 1 50       11 my $res = $self->{api}->api({
240             action => 'login',
241             lgname => $username,
242             lgpassword => $password,
243             lgdomain => $lgdomain
244             }) or return $self->_handle_api_error();
245 1         187716 $self->{api}->{ua}->{cookie_jar}->extract_cookies($self->{api}->{response});
246 1 50 33     1629 $self->{api}->{ua}->{cookie_jar}->save($cookies) if (-w($cookies) or -w('.'));
247              
248 1 50       537 return $self->_handle_api_error() unless $res->{login};
249 1 50       5 return $self->_handle_api_error() unless $res->{login}->{result};
250              
251 1 50       5 if ($res->{login}->{result} eq 'NeedToken') {
252 1         5 my $token = $res->{login}->{token};
253 1 50       13 $res = $self->{api}->api({
254             action => 'login',
255             lgname => $username,
256             lgpassword => $password,
257             lgdomain => $lgdomain,
258             lgtoken => $token,
259             }) or return $self->_handle_api_error();
260              
261 1         197158 $self->{api}->{ua}->{cookie_jar}->extract_cookies($self->{api}->{response});
262 1 50 33     159 $self->{api}->{ua}->{cookie_jar}->save($cookies) if (-w($cookies) or -w('.'));
263             }
264              
265 1 50       454 if ($res->{login}->{result} eq 'Success') {
266 0 0       0 if ($res->{login}->{lgusername} eq $self->{username}) {
267 0 0       0 $self->_do_autoconfig() if $autoconfig;
268 0 0       0 warn 'Logged in successfully with password' if $self->{debug} > 1;
269             }
270             }
271              
272             return (
273 1   0     12 (defined($res->{login}->{lgusername})) and
274             (defined($res->{login}->{result})) and
275             ($res->{login}->{lgusername} eq $self->{username}) and
276             ($res->{login}->{result} eq 'Success')
277             );
278             }
279              
280             sub _do_sul {
281 0     0   0 my $self = shift;
282 0         0 my $password = shift;
283 0         0 my $debug = $self->{debug}; # Remember these for later
284 0         0 my $host = $self->{host};
285 0         0 my $path = $self->{path};
286 0         0 my $protocol = $self->{protocol};
287 0         0 my $username = $self->{username};
288              
289 0         0 $self->{debug} = 0; # Turn off debugging for these internal calls
290 0         0 my @logins; # Keep track of our successes
291 0         0 my @WMF_projects = qw(
292             en.wikipedia.org
293             en.wiktionary.org
294             en.wikibooks.org
295             en.wikinews.org
296             en.wikiquote.org
297             en.wikisource.org
298             en.wikiversity.org
299             meta.wikimedia.org
300             commons.wikimedia.org
301             species.wikimedia.org
302             incubator.wikimedia.org
303             );
304              
305 0         0 SUL: foreach my $project (@WMF_projects) { # Could maybe be parallelized
306 0 0       0 print STDERR "Logging in on $project..." if $debug > 1;
307 0         0 $self->set_wiki({
308             host => $project,
309             });
310 0         0 my $success = $self->login({
311             username => $username,
312             password => $password,
313             do_sul => 0,
314             autoconfig => 0,
315             });
316 0 0       0 warn ($success ? " OK\n" : " FAILED:\n") if $debug > 1;
    0          
317 0 0 0     0 warn $self->{api}->{error}->{code} . ': ' . $self->{api}->{error}->{details}
318             if $debug > 1 and !$success;
319 0         0 push(@logins, $success);
320             }
321             $self->set_wiki({ # Switch back to original wiki
322 0         0 protocol => $protocol,
323             host => $host,
324             path => $path,
325             });
326              
327 0         0 my $sum = sum 0, @logins;
328 0         0 my $total = scalar @WMF_projects;
329 0 0       0 warn "$sum/$total logins succeeded" if $debug > 1;
330 0         0 $self->{debug} = $debug; # Reset debug to it's old value
331              
332 0         0 return $sum == $total;
333             }
334              
335              
336             sub logout {
337 0     0 1 0 my $self = shift;
338              
339 0         0 $self->{api}->api({ action => 'logout' });
340 0         0 return RET_TRUE;
341             }
342              
343              
344             sub edit {
345 8     8 1 1493 my $self = shift;
346 8         18 my $page;
347             my $text;
348 0         0 my $summary;
349 0         0 my $is_minor;
350 0         0 my $assert;
351 0         0 my $markasbot;
352 0         0 my $section;
353 0         0 my $captcha_id;
354 0         0 my $captcha_solution;
355              
356 8 50       49 if (ref $_[0] eq 'HASH') {
357 8         33 $page = $_[0]->{page};
358 8         20 $text = $_[0]->{text};
359 8         19 $summary = $_[0]->{summary};
360 8         20 $is_minor = $_[0]->{minor};
361 8         23 $assert = $_[0]->{assert};
362 8         17 $markasbot = $_[0]->{markasbot};
363 8         19 $section = $_[0]->{section};
364 8         18 $captcha_id = $_[0]->{captcha_id};
365 8         21 $captcha_solution = $_[0]->{captcha_solution};
366             }
367             else {
368 0         0 warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
369             . 'edit is deprecated, and will be removed in a future release.');
370 0         0 $page = shift;
371 0         0 $text = shift;
372 0         0 $summary = shift;
373 0         0 $is_minor = shift;
374 0         0 $assert = shift;
375 0         0 $markasbot = shift;
376 0         0 $section = shift;
377             }
378              
379             # Set defaults
380 8 100       34 $summary = 'BOT: Changing page text' unless $summary;
381 8 100       30 if ($assert) {
382 1         3 $assert =~ s/^[&?]assert=//;
383             }
384             else {
385 7         19 $assert = $self->{assert};
386             }
387 8 100       26 $is_minor = 1 unless defined($is_minor);
388 8 50       59 $markasbot = 1 unless defined($markasbot);
389              
390             # Clear any captcha data that might remain from a previous edit attempt
391 8         28 delete $self->{error}->{captcha};
392 8 50 33     74 carp 'Need both captcha_id and captcha_solution when editing with a solved CAPTCHA'
      33        
      33        
393             if (defined $captcha_id and not defined $captcha_solution)
394             or (defined $captcha_solution and not defined $captcha_id);
395              
396 8         47 my ($edittoken, $lastedit, $tokentime) = $self->_get_edittoken($page);
397 8 50       34 return $self->_handle_api_error() unless $edittoken;
398              
399             # HTTP::Message will do this eventually as of 6.03 (RT#75592), so we need
400             # to do it here - otherwise, the md5 won't match what eventually is sent to
401             # the server, and the edit will fail - GH#39.
402             # If HTTP::Message becomes unbroken in the future, might have to keep this
403             # workaround for people using 6.03 and other future broken versions.
404 8         106 $text =~ s{(?<!\r)\n}{\r\n}g;
405 8         99 my $md5 = md5_hex(encode_utf8($text)); # Pass only bytes to md5_hex()
406 8 100       276 my $hash = {
    100          
    50          
    50          
    50          
407             action => 'edit',
408             title => $page,
409             token => $edittoken,
410             text => $text,
411             md5 => $md5, # Guard against data corruption
412             summary => $summary,
413             basetimestamp => $lastedit, # Guard against edit conflicts
414             starttimestamp => $tokentime, # Guard against the page being deleted/moved
415             bot => $markasbot,
416             ( $section ? (section => $section) : ()),
417             ( $assert ? (assert => $assert) : ()),
418             ( $is_minor ? (minor => 1) : (notminor => 1)),
419             ( $captcha_id ? (captchaid => $captcha_id) : ()),
420             ( $captcha_solution ? (captchaword => $captcha_solution) : ()),
421             };
422              
423             ### Actually do the edit
424 8         56 my $res = $self->{api}->api($hash);
425 8 100       5157509 return $self->_handle_api_error() unless $res;
426              
427 7 100 66     92 if ($res->{edit}->{result} && $res->{edit}->{result} eq 'Failure') {
428             # https://www.mediawiki.org/wiki/API:Edit#CAPTCHAs_and_extension_errors
429             # You need to solve the CAPTCHA, then retry the request with the ID in
430             # this error response and the solution.
431 1 50       7 if (exists $res->{edit}->{captcha}) {
432 1         12 return $self->_handle_api_error({
433             code => ERR_CAPTCHA,
434             details => 'captcharequired: This action requires that a CAPTCHA be solved',
435             captcha => $res->{edit}->{captcha},
436             });
437             }
438 0         0 return $self->_handle_api_error();
439             }
440              
441 6         417 return $res;
442             }
443              
444              
445             sub move {
446 0     0 1 0 my $self = shift;
447 0         0 my $from = shift;
448 0         0 my $to = shift;
449 0         0 my $reason = shift;
450 0         0 my $opts = shift;
451              
452 0         0 my $hash = {
453             action => 'move',
454             from => $from,
455             to => $to,
456             reason => $reason,
457             };
458 0 0       0 $hash->{movetalk} = $opts->{movetalk} if defined($opts->{movetalk});
459 0 0       0 $hash->{noredirect} = $opts->{noredirect} if defined($opts->{noredirect});
460 0 0       0 $hash->{movesubpages} = $opts->{movesubpages} if defined($opts->{movesubpages});
461              
462 0         0 my $res = $self->{api}->edit($hash);
463 0 0       0 return $self->_handle_api_error() unless $res;
464 0         0 return $res; # should we return something more useful?
465             }
466              
467              
468             sub get_history {
469 5     5 1 3856 my $self = shift;
470 5         17 my $pagename = shift;
471 5   50     24 my $limit = shift || 'max';
472 5         10 my $rvstartid = shift;
473 5         13 my $direction = shift;
474              
475 5         43 my $hash = {
476             action => 'query',
477             prop => 'revisions',
478             titles => $pagename,
479             rvprop => 'ids|timestamp|user|comment|flags',
480             rvlimit => $limit
481             };
482              
483 5 50       22 $hash->{rvstartid} = $rvstartid if ($rvstartid);
484 5 50       20 $hash->{direction} = $direction if ($direction);
485              
486 5         37 my $res = $self->{api}->api($hash);
487 5 50       1653803 return $self->_handle_api_error() unless $res;
488 5         15 my ($id) = keys %{ $res->{query}->{pages} };
  5         28  
489 5         18 my $array = $res->{query}->{pages}->{$id}->{revisions};
490              
491 5         11 my @return;
492 5         12 foreach my $hash (@{$array}) {
  5         15  
493 30         43 my $revid = $hash->{revid};
494 30         39 my $user = $hash->{user};
495 30         79 my ($timestamp_date, $timestamp_time) = split(/T/, $hash->{timestamp});
496 30         125 $timestamp_time =~ s/Z$//;
497 30         92 my $comment = $hash->{comment};
498 30         181 push(
499             @return,
500             {
501             revid => $revid,
502             user => $user,
503             timestamp_date => $timestamp_date,
504             timestamp_time => $timestamp_time,
505             comment => $comment,
506             minor => exists $hash->{minor},
507             });
508             }
509 5         95 return @return;
510             }
511              
512              
513             sub get_text {
514 22     22 1 11672 my $self = shift;
515 22         61 my $pagename = shift;
516 22         49 my $revid = shift;
517 22         50 my $section = shift;
518              
519 22         165 my $hash = {
520             action => 'query',
521             titles => $pagename,
522             prop => 'revisions',
523             rvprop => 'content',
524             };
525 22 100       101 $hash->{rvstartid} = $revid if ($revid);
526 22 100       73 $hash->{rvsection} = $section if ($section);
527              
528 22         213 my $res = $self->{api}->api($hash);
529 22 50       5252339 return $self->_handle_api_error() unless $res;
530 22         53 my ($id, $data) = %{ $res->{query}->{pages} };
  22         175  
531              
532 22 100       138 return if $id == PAGE_NONEXISTENT;
533 20         383 return $data->{revisions}[0]->{'*'}; # the wikitext
534             }
535              
536              
537             sub get_id {
538 1     1 1 11 my $self = shift;
539 1         2 my $pagename = shift;
540              
541 1         5 my $hash = {
542             action => 'query',
543             titles => $pagename,
544             };
545              
546 1         7 my $res = $self->{api}->api($hash);
547 1 50       354256 return $self->_handle_api_error() unless $res;
548 1         3 my ($id) = %{ $res->{query}->{pages} };
  1         5  
549 1 50       7 return if $id == PAGE_NONEXISTENT;
550 1         11 return $id;
551             }
552              
553              
554             sub get_pages {
555 2     2 1 5096 my $self = shift;
556 2 100       11 my @pages = (ref $_[0] eq 'ARRAY') ? @{$_[0]} : @_;
  1         4  
557 2         5 my %return;
558              
559 2         18 my $hash = {
560             action => 'query',
561             titles => join('|', @pages),
562             prop => 'revisions',
563             rvprop => 'content',
564             };
565              
566 2         4 my $diff; # Used to track problematic article names
567 2         6 map { $diff->{$_} = 1; } @pages;
  8         52  
568              
569 2         15 my $res = $self->{api}->api($hash);
570 2 50       601222 return $self->_handle_api_error() unless $res;
571              
572 2         5 foreach my $id (keys %{ $res->{query}->{pages} }) {
  2         11  
573 8         21 my $page = $res->{query}->{pages}->{$id};
574 8 100       26 if ($diff->{ $page->{title} }) {
575 6         13 $diff->{ $page->{title} }++;
576             }
577             else {
578 2         5 next;
579             }
580              
581 6 100       17 if (defined($page->{missing})) {
582 2         6 $return{ $page->{title} } = undef;
583 2         4 next;
584             }
585 4 50       11 if (defined($page->{revisions})) {
586 4         8 my $revisions = @{ $page->{revisions} }[0]->{'*'};
  4         11  
587 4 50 33     19 if (!defined $revisions) {
    50          
588 0         0 $return{ $page->{title} } = $revisions;
589             }
590             elsif (length($revisions) < 150 && $revisions =~ m/\#REDIRECT\s\[\[([^\[\]]+)\]\]/) { # FRAGILE!
591 0         0 my $redirect_to = $1;
592 0         0 $return{ $page->{title} } = $self->get_text($redirect_to);
593             }
594             else {
595 4         88 $return{ $page->{title} } = $revisions;
596             }
597             }
598             }
599              
600 2         13 my $expand = $self->_get_ns_alias_data();
601             # Only for those article names that remained after the first part
602             # If we're here we are dealing most likely with a WP:CSD type of article name
603 2         11 for my $title (keys %$diff) {
604 8 100       29 if ($diff->{$title} == 1) {
605 2         9 my @pieces = split(/:/, $title);
606 2 50       8 if (@pieces > 1) {
607 2   33     11 $pieces[0] = ($expand->{ $pieces[0] } || $pieces[0]);
608 2         17 my $v = $self->get_text(join ':', @pieces);
609 2 50       13 warn "Detected article name that needed expanding $title\n" if $self->{debug} > 1;
610              
611 2         7 $return{$title} = $v;
612 2 50 33     26 if (defined $v and $v =~ m/\#REDIRECT\s\[\[([^\[\]]+)\]\]/) {
613 0         0 $v = $self->get_text($1);
614 0         0 $return{$title} = $v;
615             }
616             }
617             }
618             }
619 2         46 return \%return;
620             }
621              
622              
623             sub get_image{
624 0     0 1 0 my $self = shift;
625 0         0 my $name = shift;
626 0         0 my $options = shift;
627              
628 0         0 my %sizeparams;
629 0 0       0 $sizeparams{iiurlwidth} = $options->{width} if $options->{width};
630 0 0       0 $sizeparams{iiurlheight} = $options->{height} if $options->{height};
631              
632 0         0 my $ref = $self->{api}->api({
633             action => 'query',
634             titles => $name,
635             prop => 'imageinfo',
636             iiprop => 'url|size',
637             %sizeparams
638             });
639 0 0       0 return $self->_handle_api_error() unless $ref;
640 0         0 my ($pageref) = values %{ $ref->{query}->{pages} };
  0         0  
641 0 0       0 return unless defined $pageref->{imageinfo}; # if the image is missing
642              
643 0   0     0 my $url = @{ $pageref->{imageinfo} }[0]->{thumburl} || @{ $pageref->{imageinfo} }[0]->{url};
644 0 0       0 die "$url should be absolute or something." unless ( $url =~ m{^https?://} );
645              
646 0         0 my $response = $self->{api}->{ua}->get($url);
647 0 0       0 return $self->_handle_api_error() unless ( $response->code == 200 );
648 0         0 return $response->decoded_content;
649             }
650              
651              
652             sub revert {
653 1     1 1 88 my $self = shift;
654 1         2 my $pagename = shift;
655 1         3 my $revid = shift;
656 1   33     5 my $summary = shift || "Reverting to old revision $revid";
657              
658 1         5 my $text = $self->get_text($pagename, $revid);
659 1         10 my $res = $self->edit({
660             page => $pagename,
661             text => $text,
662             summary => $summary,
663             });
664              
665 1         11 return $res;
666             }
667              
668              
669             sub undo {
670 1     1 1 9 my $self = shift;
671 1         3 my $page = shift;
672 1   33     4 my $revid = shift || croak "No revid given";
673 1   33     7 my $summary = shift || "Reverting revision #$revid";
674 1         3 my $after = shift;
675 1 50       4 $summary = "Reverting edits between #$revid & #$after" if defined($after); # Is that clear? Correct?
676              
677 1         7 my ($edittoken, $basetimestamp, $starttimestamp) = $self->_get_edittoken($page);
678 1         10 my $hash = {
679             action => 'edit',
680             title => $page,
681             undo => $revid,
682             (undoafter => $after)x!! defined $after,
683             summary => $summary,
684             token => $edittoken,
685             starttimestamp => $starttimestamp,
686             basetimestamp => $basetimestamp,
687             };
688              
689 1         6 my $res = $self->{api}->api($hash);
690 1 50       712282 return $self->_handle_api_error() unless $res;
691 1         12 return $res;
692             }
693              
694              
695             sub get_last {
696 3     3 1 24 my $self = shift;
697 3         6 my $page = shift;
698 3         6 my $user = shift;
699              
700 3   100     49 my $res = $self->{api}->api({
701             action => 'query',
702             titles => $page,
703             prop => 'revisions',
704             rvlimit => 1,
705             rvprop => 'ids|user',
706             rvexcludeuser => $user || '',
707             });
708 3 100       1040281 return $self->_handle_api_error() unless $res;
709              
710 2         4 my (undef, $data) = %{ $res->{query}->{pages} };
  2         11  
711 2         9 my $revid = $data->{revisions}[0]->{revid};
712 2         26 return $revid;
713             }
714              
715              
716             sub update_rc {
717 1     1 1 116 warnings::warnif('deprecated', 'update_rc is deprecated, and may be removed '
718             . 'in a future release. Please use recentchanges(), which provides more '
719             . 'data, including rcid');
720 1         1159 my $self = shift;
721 1   50     5 my $limit = shift || 'max';
722 1         2 my $options = shift;
723              
724 1         6 my $hash = {
725             action => 'query',
726             list => 'recentchanges',
727             rcnamespace => 0,
728             rclimit => $limit,
729             };
730 1 50       5 $options->{max} = 1 unless $options->{max};
731              
732 1         7 my $res = $self->{api}->list($hash, $options);
733 1 50       316082 return $self->_handle_api_error() unless $res;
734 1 50       5 return RET_TRUE if not ref $res; # Not a ref when using callback
735              
736 1         3 my @rc_table;
737 1         2 foreach my $hash (@{$res}) {
  1         3  
738 2         11 push(
739             @rc_table,
740             {
741             title => $hash->{title},
742             revid => $hash->{revid},
743             old_revid => $hash->{old_revid},
744             timestamp => $hash->{timestamp},
745             }
746             );
747             }
748 1         18 return @rc_table;
749             }
750              
751              
752             sub recentchanges {
753 5     5 1 112594 my $self = shift;
754 5         11 my $ns;
755             my $limit;
756 0         0 my $options;
757 0         0 my $user;
758 0         0 my $show;
759 5 100       22 if (ref $_[0] eq 'HASH') { # unpack for new args
760 2         6 my %args = %{ +shift };
  2         12  
761 2         8 $ns = delete $args{ns};
762 2         7 $limit = delete $args{limit};
763 2         6 $user = delete $args{user};
764              
765 2 50       13 if (ref $args{show} eq 'HASH') {
766 0         0 my @show;
767 0         0 while (my ($k, $v) = each %{ $args{show} }) {
  0         0  
768 0         0 push @show, '!'x!$v . $k;
769             }
770 0         0 $show = join '|', @show;
771             }
772             else {
773 2         4 $show = delete $args{show};
774             }
775              
776 2         6 $options = shift;
777             }
778             else {
779 3   100     16 $ns = shift || 0;
780 3   100     11 $limit = shift || 50;
781 3         6 $options = shift;
782             }
783 5 100       89 $ns = join('|', @$ns) if ref $ns eq 'ARRAY';
784              
785 5         38 my $hash = {
786             action => 'query',
787             list => 'recentchanges',
788             rcnamespace => $ns,
789             rclimit => $limit,
790             rcprop => 'user|comment|timestamp|title|ids',
791             };
792 5 50       18 $hash->{rcuser} = $user if defined $user;
793 5 50       15 $hash->{rcshow} = $show if defined $show;
794              
795 5 50       25 $options->{max} = 1 unless $options->{max};
796              
797 5 50       38 my $res = $self->{api}->list($hash, $options)
798             or return $self->_handle_api_error();
799 5 100       1713175 return RET_TRUE unless ref $res; # Not a ref when using callback
800 3         64 return @$res;
801             }
802              
803              
804             sub what_links_here {
805 2     2 1 4056 my $self = shift;
806 2         5 my $page = shift;
807 2         4 my $filter = shift;
808 2         3 my $ns = shift;
809 2         5 my $options = shift;
810              
811 2 50       8 $ns = join('|', @$ns) if (ref $ns eq 'ARRAY'); # Allow array of namespaces
812 2 50 33     28 if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) { # Verify $filter
813 2         8 $filter = $1;
814             }
815              
816             # http://en.wikipedia.org/w/api.php?action=query&list=backlinks&bltitle=template:tlx
817 2         16 my $hash = {
818             action => 'query',
819             list => 'backlinks',
820             bltitle => $page,
821             bllimit => 'max',
822             };
823 2 100       7 $hash->{blnamespace} = $ns if defined $ns;
824 2 50       8 $hash->{blfilterredir} = $filter if $filter;
825 2 50       8 $options->{max} = 1 unless $options->{max};
826              
827 2         13 my $res = $self->{api}->list($hash, $options);
828 2 50       651189 return $self->_handle_api_error() unless $res;
829 2 100       16 return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference
830 1         2 my @links;
831 1         3 foreach my $hashref (@$res) {
832 14         24 my $title = $hashref->{title};
833 14         20 my $redirect = defined($hashref->{redirect});
834 14         52 push @links, { title => $title, redirect => $redirect };
835             }
836              
837 1         24 return @links;
838             }
839              
840              
841             sub list_transclusions {
842 2     2 1 3443 my $self = shift;
843 2         5 my $page = shift;
844 2         3 my $filter = shift;
845 2         3 my $ns = shift;
846 2         3 my $options = shift;
847              
848 2 50       8 $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');
849 2 50 33     35 if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) { # Verify $filter
850 2         6 $filter = $1;
851             }
852              
853             # http://en.wikipedia.org/w/api.php?action=query&list=embeddedin&eititle=Template:Stub
854 2         30 my $hash = {
855             action => 'query',
856             list => 'embeddedin',
857             eititle => $page,
858             eilimit => 'max',
859             };
860 2 50       7 $hash->{eifilterredir} = $filter if $filter;
861 2 50       5 $hash->{einamespace} = $ns if defined $ns;
862 2 50       7 $options->{max} = 1 unless $options->{max};
863              
864 2         15 my $res = $self->{api}->list($hash, $options);
865 2 50       562566 return $self->_handle_api_error() unless $res;
866 2 100       16 return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference
867 1         1 my @links;
868 1         3 foreach my $hashref (@$res) {
869 128         162 my $title = $hashref->{title};
870 128         230 my $redirect = defined($hashref->{redirect});
871 128         770 push @links, { title => $title, redirect => $redirect };
872             }
873              
874 1         70 return @links;
875             }
876              
877              
878             sub get_pages_in_category {
879 12     12 1 20 my $self = shift;
880 12         21 my $category = shift;
881 12         17 my $options = shift;
882              
883 12 50       309 if ($category =~ m/:/) { # It might have a namespace name
884 12         56 my ($cat) = split(/:/, $category, 2);
885 12 50       49 if ($cat ne 'Category') { # 'Category' is a canonical name for ns14
886 0         0 my $ns_data = $self->_get_ns_data();
887 0         0 my $cat_ns_name = $ns_data->{+NS_CATEGORY};
888 0 0       0 if ($cat ne $cat_ns_name) {
889 0         0 $category = "$cat_ns_name:$category";
890             }
891             }
892             }
893             else { # Definitely no namespace name, since there's no colon
894 0         0 $category = "Category:$category";
895             }
896 12 50       290 warn "Category to fetch is [[$category]]" if $self->{debug} > 1;
897              
898 12         169 my $hash = {
899             action => 'query',
900             list => 'categorymembers',
901             cmtitle => $category,
902             cmlimit => 'max',
903             };
904 12 50       53 $options->{max} = 1 unless defined($options->{max});
905 12 100       36 delete($options->{max}) if $options->{max} == 0;
906              
907 12         85 my $res = $self->{api}->list($hash, $options);
908 12 100       4047495 return RET_TRUE if not ref $res; # Not a hashref when using callback
909 11 50       39 return $self->_handle_api_error() unless $res;
910              
911 11         36 return map { $_->{title} } @$res;
  1957         5352  
912             }
913              
914              
915             { # Instead of using the state pragma, use a bare block
916             my %data;
917              
918             sub get_all_pages_in_category {
919 12     12 1 10481 my $self = shift;
920 12         25 my $base_category = shift;
921 12         26 my $options = shift;
922 12 100       50 $options->{max} = 0 unless defined($options->{max});
923              
924 12         49 my @first = $self->get_pages_in_category($base_category, $options);
925 12 100       667 %data = () unless $_[0]; # This is a special flag for internal use.
926             # It marks a call to this method as being
927             # internal. Since %data is a fake state variable,
928             # it needs to be cleared for every *external*
929             # call, but not cleared when the call is recursive.
930              
931 12         62 my $ns_data = $self->_get_ns_data();
932 12         47 my $cat_ns_name = $ns_data->{+NS_CATEGORY};
933              
934 12         29 foreach my $page (@first) {
935 1958 100       7498 if ($page =~ m/^$cat_ns_name:/) {
936 16 100       56 if (!exists($data{$page})) {
937 9         26 $data{$page} = '';
938 9         71 my @pages = $self->get_all_pages_in_category($page, $options, 1);
939 9         408 foreach (@pages) {
940 5870         12441 $data{$_} = '';
941             }
942             }
943             else {
944 7         18 $data{$page} = '';
945             }
946             }
947             else {
948 1942         7179 $data{$page} = '';
949             }
950             }
951 12         3483 return keys %data;
952             }
953             } # This ends the bare block around get_all_pages_in_category()
954              
955              
956             sub get_all_categories {
957 2     2 1 1381 my $self = shift;
958 2         4 my $options = shift;
959              
960 2         8 my $query = {
961             action => 'query',
962             list => 'allcategories',
963             };
964              
965 2 100 66     29 if ( defined $options && $options->{'max'} == '0' ) {
966 1         4 $query->{'aclimit'} = 'max';
967             }
968              
969 2         12 my $res = $self->{api}->api($query);
970 2 50       539765 return $self->_handle_api_error() unless $res;
971              
972 2         5 return map { $_->{'*'} } @{ $res->{'query'}->{'allcategories'} };
  510         837  
  2         10  
973             }
974              
975              
976             sub linksearch {
977 2     2 1 14872 my $self = shift;
978 2         6 my $link = shift;
979 2         3 my $ns = shift;
980 2         5 my $prot = shift;
981 2         5 my $options = shift;
982              
983 2 50       16 $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');
984              
985 2         18 my $hash = {
986             action => 'query',
987             list => 'exturlusage',
988             euprop => 'url|title',
989             euquery => $link,
990             eulimit => 'max',
991             };
992 2 50       59 $hash->{eunamespace} = $ns if defined $ns;
993 2 50       6 $hash->{euprotocol} = $prot if $prot;
994 2 50       8 $options->{max} = 1 unless $options->{max};
995              
996 2         17 my $res = $self->{api}->list($hash, $options);
997 2 50       672042 return $self->_handle_api_error() unless $res;
998 2 100       16 return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference
999              
1000 1         4 return map {{
  34         130  
1001             url => $_->{url},
1002             title => $_->{title},
1003             }} @$res;
1004              
1005             }
1006              
1007              
1008             sub purge_page {
1009 0     0 1 0 my $self = shift;
1010 0         0 my $page = shift;
1011              
1012 0         0 my $hash;
1013 0 0       0 if (ref $page eq 'ARRAY') { # If it is an array reference...
1014 0         0 $hash = {
1015             action => 'purge',
1016             titles => join('|', @$page), # dereference it and purge all those titles
1017             };
1018             }
1019             else { # Just one page
1020 0         0 $hash = {
1021             action => 'purge',
1022             titles => $page,
1023             };
1024             }
1025              
1026 0         0 my $res = $self->{api}->api($hash);
1027 0 0       0 return $self->_handle_api_error() unless $res;
1028 0         0 my $success = 0;
1029 0         0 foreach my $hashref (@{ $res->{purge} }) {
  0         0  
1030 0 0       0 $success++ if exists $hashref->{purged};
1031             }
1032 0         0 return $success;
1033             }
1034              
1035              
1036             sub get_namespace_names {
1037 5     5 1 1157 my $self = shift;
1038 5         53 my $res = $self->{api}->api({
1039             action => 'query',
1040             meta => 'siteinfo',
1041             siprop => 'namespaces',
1042             });
1043 5 50       1389605 return $self->_handle_api_error() unless $res;
1044 190         448 return map { $_ => $res->{query}->{namespaces}->{$_}->{'*'} }
  5         69  
1045 5         12 keys %{ $res->{query}->{namespaces} };
1046             }
1047              
1048              
1049             sub image_usage {
1050 3     3 1 11777 my $self = shift;
1051 3         7 my $image = shift;
1052 3         7 my $ns = shift;
1053 3         4 my $filter = shift;
1054 3         7 my $options = shift;
1055              
1056 3 50       17 if ($image !~ m/^File:|Image:/) {
1057 0         0 warnings::warnif('deprecated', q{Please include the canonical File: }
1058             . q{namespace in the image name. If you don't, MediaWiki::Bot might }
1059             . q{incur a network round-trip to get the localized namespace name});
1060 0         0 my $ns_data = $self->_get_ns_data();
1061 0         0 my $file_ns_name = $ns_data->{+NS_FILE};
1062 0 0       0 if ($image !~ m/^\Q$file_ns_name\E:/) {
1063 0         0 $image = "$file_ns_name:$image";
1064             }
1065             }
1066              
1067 3 100       59 $options->{max} = 1 unless defined($options->{max});
1068 3 50       14 delete($options->{max}) if $options->{max} == 0;
1069              
1070 3 50       12 $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');
1071              
1072 3         21 my $hash = {
1073             action => 'query',
1074             list => 'imageusage',
1075             iutitle => $image,
1076             iulimit => 'max',
1077             };
1078 3 50       9 $hash->{iunamespace} = $ns if defined $ns;
1079 3 100 66     24 if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) {
1080 1         4 $hash->{'iufilterredir'} = $1;
1081             }
1082 3         23 my $res = $self->{api}->list($hash, $options);
1083 3 50       1055754 return $self->_handle_api_error() unless $res;
1084 3 100       21 return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference
1085              
1086 2         7 return map { $_->{title} } @$res;
  1000         2580  
1087             }
1088              
1089              
1090             sub global_image_usage {
1091 3     3 1 9261 my $self = shift;
1092 3         7 my $image = shift;
1093 3         6 my $limit = shift;
1094 3         5 my $filterlocal = shift;
1095 3 100       10 $limit = defined $limit ? $limit : 500;
1096              
1097 3 100       20 if ($image !~ m/^File:|Image:/) {
1098 1         8 my $ns_data = $self->_get_ns_data();
1099 1         3 my $image_ns_name = $ns_data->{+NS_FILE};
1100 1 50       29 if ($image !~ m/^\Q$image_ns_name\E:/) {
1101 1         4 $image = "$image_ns_name:$image";
1102             }
1103             }
1104              
1105 3         6 my @data;
1106             my $cont;
1107 3 50       16 while ($limit ? scalar @data < $limit : 1) {
1108 3         18 my $hash = {
1109             action => 'query',
1110             prop => 'globalusage',
1111             titles => $image,
1112             # gufilterlocal => $filterlocal,
1113             gulimit => 'max',
1114             };
1115 3 100       12 $hash->{gufilterlocal} = $filterlocal if $filterlocal;
1116 3 50       8 $hash->{gucontinue} = $cont if $cont;
1117              
1118 3         18 my $res = $self->{api}->api($hash);
1119 3 50       1659332 return $self->_handle_api_error() unless $res;
1120              
1121 3         15 $cont = $res->{'query-continue'}->{globalusage}->{gucontinue};
1122 3 50 66     25 warn "gucontinue: $cont\n" if $cont and $self->{debug} > 1;
1123 3         6 my $page_id = (keys %{ $res->{query}->{pages} })[0];
  3         12  
1124 3         12 my $results = $res->{query}->{pages}->{$page_id}->{globalusage};
1125 3         111 push @data, @$results;
1126 3 100       3648 last unless $cont;
1127             }
1128              
1129 3 100       341 return @data > $limit
1130             ? @data[0 .. $limit-1]
1131             : @data;
1132             }
1133              
1134              
1135             sub links_to_image {
1136 1     1 1 131 warnings::warnif('deprecated', 'links_to_image is an alias of image_usage; '
1137             . 'please use the new name');
1138 1         2070 my $self = shift;
1139 1         103 return $self->image_usage($_[0]);
1140             }
1141              
1142              
1143             sub is_blocked {
1144 4     4 1 2662 my $self = shift;
1145 4         17 my $user = shift;
1146              
1147             # http://en.wikipedia.org/w/api.php?action=query&meta=blocks&bkusers=$user&bklimit=1&bkprop=id
1148 4         26 my $hash = {
1149             action => 'query',
1150             list => 'blocks',
1151             bkusers => $user,
1152             bklimit => 1,
1153             bkprop => 'id',
1154             };
1155 4         26 my $res = $self->{api}->api($hash);
1156 4 50       884356 return $self->_handle_api_error() unless $res;
1157              
1158 4         7 my $number = scalar @{ $res->{query}->{blocks} }; # The number of blocks returned
  4         15  
1159 4 100       18 if ($number == 1) {
    50          
1160 2         27 return RET_TRUE;
1161             }
1162             elsif ($number == 0) {
1163 2         26 return RET_FALSE;
1164             }
1165             else {
1166 0         0 confess "This query should return at most one result, but the API returned more than that.";
1167             }
1168             }
1169              
1170              
1171             sub test_blocked { # For backwards-compatibility
1172 2     2 1 191 warnings::warnif('deprecated', 'test_blocked is an alias of is_blocked; '
1173             . 'please use the new name. This alias might be removed in a future release');
1174 2         2029 return (is_blocked(@_));
1175             }
1176              
1177              
1178             sub test_image_exists {
1179 7     7 1 4564 my $self = shift;
1180 7         14 my $image = shift;
1181              
1182 7         13 my $multi;
1183 7 100       28 if (ref $image eq 'ARRAY') {
1184 1         3 $multi = $image; # so we know to return a hash/scalar & keep track of order
1185 1         4 $image = join('|', @$image);
1186             }
1187              
1188 7         69 my $res = $self->{api}->api({
1189             action => 'query',
1190             titles => $image,
1191             iilimit => 1,
1192             prop => 'imageinfo'
1193             });
1194 7 50       1605604 return $self->_handle_api_error() unless $res;
1195              
1196 7         13 my @sorted_ids;
1197 7 100       24 if ($multi) {
1198 1         2 my %mapped;
1199 1         17 $mapped{ $res->{query}->{pages}->{$_}->{title} } = $_
1200 1         2 for (keys %{ $res->{query}->{pages} });
1201 1         6 foreach my $file ( @$multi ) {
1202 3         13 unshift @sorted_ids, $mapped{$file};
1203             }
1204             }
1205             else {
1206 6         15 push @sorted_ids, keys %{ $res->{query}->{pages} };
  6         33  
1207             }
1208 7         22 my @return;
1209 7         19 foreach my $id (@sorted_ids) {
1210 9 100       76 if ($res->{query}->{pages}->{$id}->{imagerepository} eq 'shared') {
    100          
    50          
    50          
1211 3 100       10 if ($multi) {
1212 1         5 unshift @return, FILE_SHARED;
1213             }
1214             else {
1215 2         25 return FILE_SHARED;
1216             }
1217             }
1218             elsif (exists($res->{query}->{pages}->{$id}->{missing})) {
1219 3 100       9 if ($multi) {
1220 1         5 unshift @return, FILE_NONEXISTENT;
1221             }
1222             else {
1223 2         29 return FILE_NONEXISTENT;
1224             }
1225             }
1226             elsif ($res->{query}->{pages}->{$id}->{imagerepository} eq '') {
1227 0 0       0 if ($multi) {
1228 0         0 unshift @return, FILE_PAGE_TEXT_ONLY;
1229             }
1230             else {
1231 0         0 return FILE_PAGE_TEXT_ONLY;
1232             }
1233             }
1234             elsif ($res->{query}->{pages}->{$id}->{imagerepository} eq 'local') {
1235 3 100       9 if ($multi) {
1236 1         5 unshift @return, FILE_LOCAL;
1237             }
1238             else {
1239 2         28 return FILE_LOCAL;
1240             }
1241             }
1242             }
1243              
1244 1         15 return \@return;
1245             }
1246              
1247              
1248             sub get_pages_in_namespace {
1249 4     4 1 7050 my $self = shift;
1250 4         12 my $namespace = shift;
1251 4   100     25 my $limit = shift || 'max';
1252 4         6 my $options = shift;
1253              
1254 4         30 my $hash = {
1255             action => 'query',
1256             list => 'allpages',
1257             apnamespace => $namespace,
1258             aplimit => $limit,
1259             };
1260 4 100       20 $options->{max} = 1 unless defined $options->{max};
1261 4 100 66     34 delete $options->{max} if exists $options->{max} and $options->{max} == 0;
1262              
1263 4         30 my $res = $self->{api}->list($hash, $options);
1264 4 100       3649713 return $self->_handle_api_error() unless $res;
1265 3 50       15 return RET_TRUE if not ref $res; # Not a ref when using callback
1266 3         35 return map { $_->{title} } @$res;
  5043         19689  
1267             }
1268              
1269              
1270             sub count_contributions {
1271 2     2 1 14 my $self = shift;
1272 2         4 my $username = shift;
1273 2         7 $username =~ s/User://i; # Strip namespace
1274              
1275 2         23 my $res = $self->{api}->list({
1276             action => 'query',
1277             list => 'users',
1278             ususers => $username,
1279             usprop => 'editcount'
1280             },
1281             { max => 1 });
1282 2 50       639723 return $self->_handle_api_error() unless $res;
1283 2         7 return ${$res}[0]->{editcount};
  2         21  
1284             }
1285              
1286              
1287             sub timed_count_contributions {
1288 0     0 1 0 my $self = shift;
1289 0         0 my $username = shift;
1290 0         0 my $days = shift;
1291 0         0 $username =~ s/User://i; # Strip namespace
1292              
1293 0         0 my $res = $self->{api}->api({
1294             action => 'userdailycontribs',
1295             user => $username,
1296             daysago => $days,
1297             },
1298             { max => 1 });
1299 0 0       0 return $self->_handle_api_error() unless $res;
1300 0         0 return ($res->{userdailycontribs}->{timeFrameEdits}, $res->{userdailycontribs}->{totalEdits});
1301             }
1302              
1303              
1304             sub last_active {
1305 2     2 1 869 my $self = shift;
1306 2         3 my $username = shift;
1307 2 100       9 $username = "User:$username" unless $username =~ /User:/i;
1308 2         22 my $res = $self->{api}->list({
1309             action => 'query',
1310             list => 'usercontribs',
1311             ucuser => $username,
1312             uclimit => 1
1313             },
1314             { max => 1 });
1315 2 50       527342 return $self->_handle_api_error() unless $res;
1316 2         6 return ${$res}[0]->{timestamp};
  2         18  
1317             }
1318              
1319              
1320             sub recent_edit_to_page {
1321 1     1 1 1320 my $self = shift;
1322 1         4 my $page = shift;
1323 1         14 my $res = $self->{api}->api({
1324             action => 'query',
1325             prop => 'revisions',
1326             titles => $page,
1327             rvlimit => 1
1328             },
1329             { max => 1 });
1330 1 50       169848 return $self->_handle_api_error() unless $res;
1331 1         3 my $data = ( %{ $res->{query}->{pages} } )[1];
  1         5  
1332 1         14 return ($data->{revisions}[0]->{timestamp},
1333             $data->{revisions}[0]->{user});
1334             }
1335              
1336              
1337             sub get_users {
1338 1     1 1 43 my $self = shift;
1339 1         3 my $pagename = shift;
1340 1   50     7 my $limit = shift || 'max';
1341 1         3 my $rvstartid = shift;
1342 1         3 my $direction = shift;
1343              
1344 1 50       6 if ($limit > 50) {
1345 0         0 $self->{errstr} = "Error requesting history for $pagename: Limit may not be set to values above 50";
1346 0         0 carp $self->{errstr};
1347 0         0 return;
1348             }
1349 1         9 my $hash = {
1350             action => 'query',
1351             prop => 'revisions',
1352             titles => $pagename,
1353             rvprop => 'ids|timestamp|user|comment',
1354             rvlimit => $limit,
1355             };
1356 1 50       6 $hash->{rvstartid} = $rvstartid if ($rvstartid);
1357 1 50       5 $hash->{rvdir} = $direction if ($direction);
1358              
1359 1         7 my $res = $self->{api}->api($hash);
1360 1 50       207404 return $self->_handle_api_error() unless $res;
1361              
1362 1         2 my ($id) = keys %{ $res->{query}->{pages} };
  1         5  
1363 1         3 return map { $_->{user} } @{$res->{query}->{pages}->{$id}->{revisions}};
  5         28  
  1         4  
1364             }
1365              
1366              
1367             sub was_blocked {
1368 4     4 1 1979 my $self = shift;
1369 4         9 my $user = shift;
1370 4         11 $user =~ s/User://i; # Strip User: prefix, if present
1371              
1372             # http://en.wikipedia.org/w/api.php?action=query&list=logevents&letype=block&letitle=User:127.0.0.1&lelimit=1&leprop=ids
1373 4         38 my $hash = {
1374             action => 'query',
1375             list => 'logevents',
1376             letype => 'block',
1377             letitle => "User:$user", # Ensure the User: prefix is there!
1378             lelimit => 1,
1379             leprop => 'ids',
1380             };
1381              
1382 4         26 my $res = $self->{api}->api($hash);
1383 4 50       936451 return $self->_handle_api_error() unless $res;
1384              
1385 4         10 my $number = scalar @{ $res->{query}->{logevents} }; # The number of blocks returned
  4         14  
1386 4 100       25 if ($number == 1) {
    50          
1387 2         33 return RET_TRUE;
1388             }
1389             elsif ($number == 0) {
1390 2         33 return RET_FALSE;
1391             }
1392             else {
1393 0         0 confess "This query should return at most one result, but the API returned more than that.";
1394             }
1395             }
1396              
1397              
1398             sub test_block_hist { # Backwards compatibility
1399 2     2 1 651 warnings::warnif('deprecated', 'test_block_hist is an alias of was_blocked; '
1400             . 'please use the new method name. This alias might be removed in a future release');
1401 2         2583 return (was_blocked(@_));
1402             }
1403              
1404              
1405             sub expandtemplates {
1406 2     2 1 10 my $self = shift;
1407 2         4 my $page = shift;
1408 2         4 my $text = shift;
1409              
1410 2 100       8 unless ($text) {
1411 1 50       4 croak q{You must provide a page title} unless $page;
1412 1         5 $text = $self->get_text($page);
1413             }
1414              
1415 2 100       24 my $hash = {
1416             action => 'expandtemplates',
1417             prop => 'wikitext',
1418             ( $page ? (title => $page) : ()),
1419             text => $text,
1420             };
1421 2         16 my $res = $self->{api}->api($hash);
1422 2 50       1127438 return $self->_handle_api_error() unless $res;
1423              
1424 2 50       37 return exists $res->{expandtemplates}->{'*'}
1425             ? $res->{expandtemplates}->{'*'}
1426             : $res->{expandtemplates}->{wikitext};
1427             }
1428              
1429              
1430             sub get_allusers {
1431 2     2 1 1317 my $self = shift;
1432 2   50     9 my $limit = shift || 'max';
1433 2         4 my $group = shift;
1434 2         4 my $opts = shift;
1435              
1436 2         10 my $hash = {
1437             action => 'query',
1438             list => 'allusers',
1439             aulimit => $limit,
1440             };
1441 2 100       8 $hash->{augroup} = $group if defined $group;
1442 2 50       11 $opts->{max} = 1 unless exists $opts->{max};
1443 2 50 33     14 delete $opts->{max} if exists $opts->{max} and $opts->{max} == 0;
1444 2         14 my $res = $self->{api}->list($hash, $opts);
1445 2 50       680750 return $self->_handle_api_error() unless $res;
1446 2 50       9 return RET_TRUE if not ref $res; # Not a ref when using callback
1447              
1448 2         5 return map { $_->{name} } @$res;
  20         52  
1449             }
1450              
1451              
1452             sub db_to_domain {
1453 1     1 1 22 my $self = shift;
1454 1         2 my $wiki = shift;
1455              
1456 1 50       12 if (!$self->{sitematrix}) {
1457 1         6 $self->_get_sitematrix();
1458             }
1459              
1460 1 50       12 if (ref $wiki eq 'ARRAY') {
1461 1         3 my @return;
1462 1         5 foreach my $w (@$wiki) {
1463 6         17 $wiki =~ s/_p$//; # Strip off a _p suffix, if present
1464 6   100     37 my $domain = $self->{sitematrix}->{$w} || undef;
1465 6         19 push(@return, $domain);
1466             }
1467 1         11 return \@return;
1468             }
1469             else {
1470 0         0 $wiki =~ s/_p$//; # Strip off a _p suffix, if present
1471 0   0     0 my $domain = $self->{sitematrix}->{$wiki} || undef;
1472 0         0 return $domain;
1473             }
1474             }
1475              
1476              
1477             sub domain_to_db {
1478 1     1 1 1301 my $self = shift;
1479 1         4 my $wiki = shift;
1480              
1481 1 50       6 if (!$self->{sitematrix}) {
1482 0         0 $self->_get_sitematrix();
1483             }
1484              
1485 1 50       9 if (ref $wiki eq 'ARRAY') {
1486 1         3 my @return;
1487 1         3 foreach my $w (@$wiki) {
1488 6   100     33 my $db = $self->{sitematrix}->{$w} || undef;
1489 6         15 push(@return, $db);
1490             }
1491 1         6 return \@return;
1492             }
1493             else {
1494 0   0     0 my $db = $self->{sitematrix}->{$wiki} || undef;
1495 0         0 return $db;
1496             }
1497             }
1498              
1499              
1500             sub diff {
1501 1     1 1 13 my $self = shift;
1502 1         2 my $title;
1503             my $revid;
1504 0         0 my $oldid;
1505              
1506 1 50       4 if (ref $_[0] eq 'HASH') {
1507 1         15 $title = $_[0]->{title};
1508 1         4 $revid = $_[0]->{revid};
1509 1         4 $oldid = $_[0]->{oldid};
1510             }
1511             else {
1512 0         0 $title = shift;
1513 0         0 $revid = shift;
1514 0         0 $oldid = shift;
1515             }
1516              
1517 1         5 my $hash = {
1518             action => 'query',
1519             prop => 'revisions',
1520             rvdiffto => $oldid,
1521             };
1522 1 50       7 if ($title) {
    50          
1523 0         0 $hash->{titles} = $title;
1524 0         0 $hash->{rvlimit} = 1;
1525             }
1526             elsif ($revid) {
1527 1         3 $hash->{'revids'} = $revid;
1528             }
1529              
1530 1         7 my $res = $self->{api}->api($hash);
1531 1 50       343947 return $self->_handle_api_error() unless $res;
1532 1         3 my @revids = keys %{ $res->{query}->{pages} };
  1         7  
1533 1         4 my $diff = $res->{query}->{pages}->{ $revids[0] }->{revisions}->[0]->{diff}->{'*'};
1534              
1535 1         14 return $diff;
1536             }
1537              
1538              
1539             sub prefixindex {
1540 1     1 1 13 my $self = shift;
1541 1         3 my $prefix = shift;
1542 1         2 my $ns = shift;
1543 1         2 my $filter = shift;
1544 1         2 my $options = shift;
1545              
1546 1 50 33     6 if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) { # Verify
1547 0         0 $filter = $1;
1548             }
1549              
1550 1 50 33     11 if (!defined $ns && $prefix =~ m/:/) {
1551 1 50       6 print STDERR "Converted '$prefix' to..." if $self->{debug} > 1;
1552 1         5 my ($name) = split(/:/, $prefix, 2);
1553 1         5 my $ns_data = $self->_get_ns_data();
1554 1         4 $ns = $ns_data->{$name};
1555 1         29 $prefix =~ s/^$name://;
1556 1 50       7 warn "'$prefix' with a namespace filter $ns" if $self->{debug} > 1;
1557             }
1558              
1559 1         7 my $hash = {
1560             action => 'query',
1561             list => 'allpages',
1562             apprefix => $prefix,
1563             aplimit => 'max',
1564             };
1565 1 50       7 $hash->{apnamespace} = $ns if defined $ns;
1566 1 50       4 $hash->{apfilterredir} = $filter if $filter;
1567 1 50       5 $options->{max} = 1 unless $options->{max};
1568              
1569 1         8 my $res = $self->{api}->list($hash, $options);
1570              
1571 1 50       207026 return $self->_handle_api_error() unless $res;
1572 1 50       5 return RET_TRUE if not ref $res; # Not a ref when using callback hook
1573              
1574 3         27 return map {
1575 1         4 { title => $_->{title}, redirect => defined $_->{redirect} }
1576             } @$res;
1577             }
1578              
1579              
1580             sub search {
1581 2     2 1 1682 my $self = shift;
1582 2         5 my $term = shift;
1583 2   50     27 my $ns = shift || 0;
1584 2         4 my $options = shift;
1585              
1586 2 50       10 if (ref $ns eq 'ARRAY') { # Accept a hashref
1587 0         0 $ns = join('|', @$ns);
1588             }
1589              
1590 2         18 my $hash = {
1591             action => 'query',
1592             list => 'search',
1593             srsearch => $term,
1594             srwhat => 'text',
1595             srlimit => 'max',
1596              
1597             #srinfo => 'totalhits',
1598             srprop => 'size',
1599             srredirects => 0,
1600             };
1601 2 50       11 $options->{max} = 1 unless $options->{max};
1602              
1603 2         14 my $res = $self->{api}->list($hash, $options);
1604 2 50       592457 return $self->_handle_api_error() unless $res;
1605 2 50       9 return RET_TRUE if not ref $res; # Not a ref when used with callback
1606              
1607 2         19 return map { $_->{title} } @$res;
  50         138  
1608             }
1609              
1610              
1611             sub get_log {
1612 1     1 1 16 my $self = shift;
1613 1         1 my $data = shift;
1614 1         2 my $options = shift;
1615              
1616 1         3 my $log_type = $data->{type};
1617 1         2 my $user = $data->{user};
1618 1         1 my $target = $data->{target};
1619              
1620 1 50       5 if ($user) {
1621 1         14 my $ns_data = $self->_get_ns_data();
1622 1         4 my $user_ns_name = $ns_data->{+NS_USER};
1623 1         25 $user =~ s/^$user_ns_name://;
1624             }
1625              
1626 1         7 my $hash = {
1627             action => 'query',
1628             list => 'logevents',
1629             lelimit => 'max',
1630             };
1631 1 50       6 $hash->{letype} = $log_type if $log_type;
1632 1 50       4 $hash->{leuser} = $user if $user;
1633 1 50       5 $hash->{letitle} = $target if $target;
1634 1 50       8 $options->{max} = 1 unless $options->{max};
1635              
1636 1         7 my $res = $self->{api}->list($hash, $options);
1637 1 50       184464 return $self->_handle_api_error() unless $res;
1638 1 50       6 return RET_TRUE if not ref $res; # Not a ref when using callback
1639              
1640 1         12 return $res;
1641             }
1642              
1643              
1644             sub is_g_blocked {
1645 1     1 1 12 my $self = shift;
1646 1         3 my $ip = shift;
1647              
1648             # http://en.wikipedia.org/w/api.php?action=query&list=globalblocks&bglimit=1&bgprop=address&bgip=127.0.0.1
1649 1         12 my $res = $self->{api}->api({
1650             action => 'query',
1651             list => 'globalblocks',
1652             bglimit => 1,
1653             bgprop => 'address',
1654             # So handy! It searches for blocks affecting this IP or IP range,
1655             # including rangeblocks! Can't get that from UI.
1656             bgip => $ip,
1657             });
1658 1 50       337496 return $self->_handle_api_error() unless $res;
1659 1 50       11 return RET_FALSE unless ($res->{query}->{globalblocks}->[0]);
1660              
1661 0         0 return $res->{query}->{globalblocks}->[0]->{address};
1662             }
1663              
1664              
1665             sub was_g_blocked {
1666 2     2 1 14 my $self = shift;
1667 2         5 my $ip = shift;
1668 2         7 $ip =~ s/User://i; # Strip User: prefix, if present
1669              
1670             # This query should always go to Meta
1671 2 50       10 unless ( $self->{host} eq 'meta.wikimedia.org' ) {
1672 0 0       0 carp "GlobalBlocking queries should probably be sent to Meta; it doesn't look like you're doing so" if $self->{debug};
1673             }
1674              
1675             # http://meta.wikimedia.org/w/api.php?action=query&list=logevents&letype=gblblock&letitle=User:127.0.0.1&lelimit=1&leprop=ids
1676 2         25 my $res = $self->{api}->api({
1677             action => 'query',
1678             list => 'logevents',
1679             letype => 'gblblock',
1680             letitle => "User:$ip", # Ensure the User: prefix is there!
1681             lelimit => 1,
1682             leprop => 'ids',
1683             });
1684              
1685 2 50       659906 return $self->_handle_api_error() unless $res;
1686 2         5 my $number = scalar @{ $res->{query}->{logevents} }; # The number of blocks returned
  2         9  
1687              
1688 2 100       14 if ($number == 1) {
    50          
1689 1         14 return RET_TRUE;
1690             }
1691             elsif ($number == 0) {
1692 1         12 return RET_FALSE;
1693             }
1694             else {
1695 0         0 confess "This query should return at most one result, but the API gave more than that.";
1696             }
1697             }
1698              
1699              
1700             sub was_locked {
1701 2     2 1 894 my $self = shift;
1702 2         5 my $user = shift;
1703              
1704             # This query should always go to Meta
1705 2 50       23 unless (
1706             $self->{api}->{config}->{api_url} =~ m,
1707             \Qhttp://meta.wikimedia.org/w/api.php\E
1708             |
1709             \Qhttps://secure.wikimedia.org/wikipedia/meta/w/api.php\E
1710             ,x # /x flag is pretty awesome :)
1711             )
1712             {
1713 0 0       0 carp "CentralAuth queries should probably be sent to Meta; it doesn't look like you're doing so" if $self->{debug};
1714             }
1715              
1716 2         8 $user =~ s/^User://i;
1717 2         6 $user =~ s/\@global$//i;
1718 2         31 my $res = $self->{api}->api({
1719             action => 'query',
1720             list => 'logevents',
1721             letype => 'globalauth',
1722             letitle => "User:$user\@global",
1723             lelimit => 1,
1724             leprop => 'ids',
1725             });
1726 2 50       588143 return $self->_handle_api_error() unless $res;
1727 2         5 my $number = scalar @{ $res->{query}->{logevents} };
  2         10  
1728 2 100       12 if ($number == 1) {
    50          
1729 1         9 return RET_TRUE;
1730             }
1731             elsif ($number == 0) {
1732 1         9 return RET_FALSE;
1733             }
1734             else {
1735 0         0 confess "This query should return at most one result, but the API returned more than that.";
1736             }
1737             }
1738              
1739              
1740             sub get_protection {
1741 3     3 1 1914 my $self = shift;
1742 3         7 my $page = shift;
1743 3 100       13 if (ref $page eq 'ARRAY') {
1744 1         7 $page = join('|', @$page);
1745             }
1746              
1747 3         20 my $hash = {
1748             action => 'query',
1749             titles => $page,
1750             prop => 'info',
1751             inprop => 'protection',
1752             };
1753 3         23 my $res = $self->{api}->api($hash);
1754 3 50       949649 return $self->_handle_api_error() unless $res;
1755              
1756 3         9 my $data = $res->{query}->{pages};
1757              
1758 3         5 my $out_data;
1759 3         11 foreach my $item (keys %$data) {
1760 4         9 my $title = $data->{$item}->{title};
1761 4         9 my $protection = $data->{$item}->{protection};
1762 4 100       10 if (@$protection == 0) {
1763 3         8 $protection = undef;
1764             }
1765 4         17 $out_data->{$title} = $protection;
1766             }
1767              
1768 3 100       13 if (scalar keys %$out_data == 1) {
1769 2         30 return $out_data->{$page};
1770             }
1771             else {
1772 1         14 return $out_data;
1773             }
1774             }
1775              
1776              
1777             sub is_protected {
1778 1     1 1 97 warnings::warnif('deprecated', 'is_protected is deprecated, and might be '
1779             . 'removed in a future release; please use get_protection instead');
1780 1         1768 my $self = shift;
1781 1         6 return $self->get_protection(@_);
1782             }
1783              
1784              
1785             sub patrol {
1786 0     0 1 0 my $self = shift;
1787 0         0 my $rcid = shift;
1788              
1789 0 0       0 if (ref $rcid eq 'ARRAY') {
1790 0         0 my @return;
1791 0         0 foreach my $id (@$rcid) {
1792 0         0 my $res = $self->patrol($id);
1793 0         0 push(@return, $res);
1794             }
1795 0         0 return @return;
1796             }
1797             else {
1798 0         0 my ($token) = $self->_get_edittoken('patrol');
1799 0         0 my $res = $self->{api}->api({
1800             action => 'patrol',
1801             rcid => $rcid,
1802             token => $token,
1803             });
1804 0 0 0     0 return $self->_handle_api_error()
      0        
1805             if !$res
1806             or $self->{error}->{details} && $self->{error}->{details} =~ m/^(?:permissiondenied|badtoken)/;
1807              
1808 0         0 return $res;
1809             }
1810             }
1811              
1812              
1813             sub email {
1814 0     0 1 0 my $self = shift;
1815 0         0 my $user = shift;
1816 0         0 my $subject = shift;
1817 0         0 my $body = shift;
1818              
1819 0 0       0 if (ref $user eq 'ARRAY') {
1820 0         0 my @return;
1821 0         0 foreach my $target (@$user) {
1822 0         0 my $res = $self->email($target, $subject, $body);
1823 0         0 push(@return, $res);
1824             }
1825 0         0 return @return;
1826             }
1827              
1828 0         0 $user =~ s/^User://;
1829 0 0       0 if ($user =~ m/:/) {
1830 0         0 my $user_ns_name = $self->_get_ns_data()->{+NS_USER};
1831 0         0 $user =~ s/^$user_ns_name://;
1832             }
1833              
1834 0         0 my ($token) = $self->_get_edittoken;
1835 0         0 my $res = $self->{api}->api({
1836             action => 'emailuser',
1837             target => $user,
1838             subject => $subject,
1839             text => $body,
1840             token => $token,
1841             });
1842 0 0       0 return $self->_handle_api_error() unless $res;
1843 0         0 return $res;
1844             }
1845              
1846              
1847             sub top_edits {
1848 0     0 1 0 my $self = shift;
1849 0         0 my $user = shift;
1850 0         0 my $options = shift;
1851              
1852 0         0 $user =~ s/^User://;
1853              
1854 0 0       0 $options->{max} = 1 unless defined($options->{max});
1855 0 0       0 delete($options->{max}) if $options->{max} == 0;
1856              
1857 0         0 my $res = $self->{'api'}->list({
1858             action => 'query',
1859             list => 'usercontribs',
1860             ucuser => $user,
1861             ucprop => 'title|flags',
1862             uclimit => 'max',
1863             }, $options);
1864 0 0       0 return $self->_handle_api_error() unless $res;
1865 0 0       0 return RET_TRUE if not ref $res; # Not a ref when using callback
1866              
1867             return
1868 0         0 map { $_->{title} }
  0         0  
1869 0         0 grep { exists $_->{top} }
1870             @$res;
1871             }
1872              
1873              
1874             sub contributions {
1875 3     3 1 4657 my $self = shift;
1876 3         9 my $user = shift;
1877 3         4 my $ns = shift;
1878 3         6 my $opts = shift;
1879              
1880 3 100       12 if (ref $user eq 'ARRAY') {
1881 1         4 $user = join '|', map { my $u = $_; $u =~ s{^User:}{}; $u } @$user;
  2         3  
  2         7  
  2         7  
1882             }
1883             else {
1884 2         7 $user =~ s{^User:}{};
1885             }
1886 3 50       11 $ns = join '|', @$ns
1887             if ref $ns eq 'ARRAY';
1888              
1889 3 50       17 $opts->{max} = 1 unless defined($opts->{max});
1890 3 50       9 delete($opts->{max}) if $opts->{max} == 0;
1891              
1892 3 100       28 my $query = {
1893             action => 'query',
1894             list => 'usercontribs',
1895             ucuser => $user,
1896             ( defined $ns ? (ucnamespace => $ns) : ()),
1897             ucprop => 'ids|title|timestamp|comment|flags',
1898             uclimit => 'max',
1899             };
1900 3         17 my $res = $self->{api}->list($query, $opts);
1901 3 50       860527 return $self->_handle_api_error() unless $res->[0];
1902 3 50       12 return RET_TRUE if not ref $res; # Not a ref when using callback
1903              
1904 3         178 return @$res;
1905             }
1906              
1907              
1908             sub upload {
1909 0     0 1 0 my $self = shift;
1910 0         0 my $args = shift;
1911              
1912 0         0 my $data = delete $args->{data};
1913 0 0 0     0 if (!defined $data and defined $args->{file}) {
1914 0 0       0 $data = do { local $/; open my $in, '<:raw', $args->{file} or die $!; <$in> };
  0         0  
  0         0  
  0         0  
1915             }
1916 0 0       0 unless (defined $data) {
1917 0         0 $self->{error}->{code} = ERR_PARAMS;
1918 0         0 $self->{error}->{details} = q{You must provide either file contents or a filename.};
1919 0         0 return undef;
1920             }
1921 0 0 0     0 unless (defined $args->{file} or defined $args->{title}) {
1922 0         0 $self->{error}->{code} = ERR_PARAMS;
1923 0         0 $self->{error}->{details} = q{You must specify a title to upload to.};
1924 0         0 return undef;
1925             }
1926              
1927 0   0     0 my $filename = $args->{title} || do { require File::Basename; File::Basename::basename($args->{file}) };
1928 0   0     0 my $success = $self->{api}->edit({
1929             action => 'upload',
1930             filename => $filename,
1931             comment => $args->{summary},
1932             file => [ undef, $filename, Content => $data ],
1933             }) || return $self->_handle_api_error();
1934 0         0 return $success;
1935             }
1936              
1937              
1938             sub upload_from_url {
1939 0     0 1 0 my $self = shift;
1940 0         0 my $args = shift;
1941              
1942 0         0 my $url = delete $args->{url};
1943 0 0       0 unless (defined $url) {
1944 0         0 $self->{error}->{code} = ERR_PARAMS;
1945 0         0 $self->{error}->{details} = q{You must provide URL of file to upload.};
1946 0         0 return undef;
1947             }
1948              
1949 0   0     0 my $filename = $args->{title} || do {
1950             require File::Basename;
1951             File::Basename::basename($url)
1952             };
1953 0   0     0 my $success = $self->{api}->edit({
1954             action => 'upload',
1955             filename => $filename,
1956             comment => $args->{summary},
1957             url => $url,
1958             ignorewarnings => 1,
1959             }) || return $self->_handle_api_error();
1960 0         0 return $success;
1961             }
1962              
1963              
1964              
1965             sub usergroups {
1966 1     1 1 11 my $self = shift;
1967 1         2 my $user = shift;
1968              
1969 1         4 $user =~ s/^User://;
1970              
1971 1         23 my $res = $self->{api}->api({
1972             action => 'query',
1973             list => 'users',
1974             ususers => $user,
1975             usprop => 'groups',
1976             ustoken => 'userrights',
1977             });
1978 1 50       320487 return $self->_handle_api_error() unless $res;
1979              
1980 1         3 foreach my $res_user (@{ $res->{query}->{users} }) {
  1         5  
1981 1 50       5 next unless $res_user->{name} eq $user;
1982              
1983             # Cache the userrights token on the assumption that we'll use it shortly to change the rights
1984 1         10 $self->{userrightscache} = {
1985             user => $user,
1986             token => $res_user->{userrightstoken},
1987             groups => $res_user->{groups},
1988             };
1989              
1990 1         2 return @{ $res_user->{groups} }; # SUCCESS
  1         12  
1991             }
1992              
1993 0         0 return $self->_handle_api_error({ code => ERR_API, details => qq{Results for $user weren't returned by the API} });
1994             }
1995              
1996              
1997             ################
1998             # Internal use #
1999             ################
2000              
2001             sub _get_edittoken { # Actually returns ($token, $base_timestamp, $start_timestamp)
2002 9     9   18 my $self = shift;
2003 9   50     32 my $page = shift || 'Main Page';
2004 9   50     70 my $type = shift || 'csrf';
2005              
2006 9 50       120 my $res = $self->{api}->api({
2007             action => 'query',
2008             meta => 'siteinfo|tokens',
2009             titles => $page,
2010             prop => 'revisions',
2011             rvprop => 'timestamp',
2012             type => $type,
2013             }) or return $self->_handle_api_error();
2014              
2015 9         2615102 my $data = ( %{ $res->{query}->{pages} })[1];
  9         116  
2016 9         37 my $base_timestamp = $data->{revisions}[0]->{timestamp};
2017 9         30 my $start_timestamp = $res->{query}->{general}->{time};
2018 9         36 my $token = $res->{query}->{tokens}->{"${type}token"};
2019              
2020 9         155 return ($token, $base_timestamp, $start_timestamp);
2021             }
2022              
2023             sub _handle_api_error {
2024 4     4   11 my $self = shift;
2025 4         10 my $error = shift;
2026              
2027 4         20 $self->{error} = {};
2028              
2029 4 50       24 carp 'Error code '
2030             . $self->{api}->{error}->{code}
2031             . ': '
2032             . $self->{api}->{error}->{details} if $self->{debug};
2033 4 100 33     50 $self->{error} =
2034             (defined $error and ref $error eq 'HASH' and exists $error->{code} and exists $error->{details})
2035             ? $error
2036             : $self->{api}->{error};
2037              
2038 4         46 return undef;
2039             }
2040              
2041             sub _is_loggedin {
2042 1     1   2 my $self = shift;
2043              
2044 1   50     5 my $is = $self->_whoami() || return $self->_handle_api_error();
2045 1         5 my $ought = $self->{username};
2046 1 50       5 warn "Testing if logged in: we are $is, and we should be $ought" if $self->{debug} > 1;
2047 1         7 return ($is eq $ought);
2048             }
2049              
2050             sub _whoami {
2051 1     1   2 my $self = shift;
2052              
2053 1 50       9 my $res = $self->{api}->api({
2054             action => 'query',
2055             meta => 'userinfo',
2056             }) or return $self->_handle_api_error();
2057              
2058 1         411741 return $res->{query}->{userinfo}->{name};
2059             }
2060              
2061             sub _do_autoconfig {
2062 0     0   0 my $self = shift;
2063              
2064             # http://en.wikipedia.org/w/api.php?action=query&meta=userinfo&uiprop=rights|groups
2065 0         0 my $hash = {
2066             action => 'query',
2067             meta => 'userinfo',
2068             uiprop => 'rights|groups',
2069             };
2070 0         0 my $res = $self->{api}->api($hash);
2071 0 0       0 return $self->_handle_api_error() unless $res;
2072 0 0       0 return $self->_handle_api_error() unless $res->{query};
2073 0 0       0 return $self->_handle_api_error() unless $res->{query}->{userinfo};
2074 0 0       0 return $self->_handle_api_error() unless $res->{query}->{userinfo}->{name};
2075              
2076 0         0 my $is = $res->{query}->{userinfo}->{name};
2077 0         0 my $ought = $self->{username};
2078              
2079             # Should we try to recover by logging in again? croak?
2080 0 0       0 carp "We're logged in as $is but we should be logged in as $ought" if ($is ne $ought);
2081              
2082 0 0       0 my @rights = @{ $res->{query}->{userinfo}->{rights} || [] };
  0         0  
2083 0         0 my $has_bot = 0;
2084 0         0 my $default_assert = 'user'; # At a *minimum*, the bot should be logged in.
2085 0         0 foreach my $right (@rights) {
2086 0 0       0 if ($right eq 'bot') {
2087 0         0 $has_bot = 1;
2088 0         0 $default_assert = 'bot';
2089             }
2090             }
2091              
2092 0 0       0 my @groups = @{ $res->{query}->{userinfo}->{groups} || [] }; # athere may be no groups
  0         0  
2093 0         0 my $is_sysop = 0;
2094 0         0 foreach my $group (@groups) {
2095 0 0       0 if ($group eq 'sysop') {
2096 0         0 $is_sysop = 1;
2097             }
2098             }
2099              
2100 0 0 0     0 unless ($has_bot && !$is_sysop) {
2101 0 0       0 warn "$is doesn't have a bot flag; edits will be visible in RecentChanges" if $self->{debug} > 1;
2102             }
2103 0 0       0 $self->{assert} = $default_assert unless $self->{assert};
2104              
2105 0         0 return RET_TRUE;
2106             }
2107              
2108             sub _get_sitematrix {
2109 1     1   4 my $self = shift;
2110              
2111 1         9 my $res = $self->{api}->api({ action => 'sitematrix' });
2112 1 50       539790 return $self->_handle_api_error() unless $res;
2113 1         3 my %sitematrix = %{ $res->{sitematrix} };
  1         253  
2114              
2115             # This hash is a monstrosity (see http://sprunge.us/dfBD?pl), and needs
2116             # lots of post-processing to have a sane data structure :\
2117 1         16 my %by_db;
2118 1         34 SECTION: foreach my $hashref (%sitematrix) {
2119 594 100       1608 if (ref $hashref ne 'HASH') { # Yes, there are non-hashrefs in here, wtf?!
2120 299 100       760 if ($hashref eq 'specials') {
2121 1         2 SPECIAL: foreach my $special (@{ $sitematrix{specials} }) {
  1         4  
2122             next SPECIAL
2123 87 100 100     667 if (exists($special->{private})
2124             or exists($special->{fishbowl}));
2125              
2126 51         90 my $db = $special->{code};
2127 51         97 my $domain = $special->{url};
2128 51         259 $domain =~ s,^http://,,;
2129              
2130 51         235 $by_db{$db} = $domain;
2131             }
2132             }
2133 299         527 next SECTION;
2134             }
2135              
2136 295         555 my $lang = $hashref->{code};
2137              
2138 295         860 WIKI: foreach my $wiki_ref ($hashref->{site}) {
2139 295         776 WIKI2: foreach my $wiki_ref2 (@$wiki_ref) {
2140 797         1770 my $family = $wiki_ref2->{code};
2141 797         1721 my $domain = $wiki_ref2->{url};
2142 797         3694 $domain =~ s,^http://,,;
2143              
2144 797         1496 my $db = $lang . $family; # Is simple concatenation /always/ correct?
2145              
2146 797         3662 $by_db{$db} = $domain;
2147             }
2148             }
2149             }
2150              
2151             # Now filter out closed wikis
2152 1         56 my $response = $self->{api}->{ua}->get('http://noc.wikimedia.org/conf/closed.dblist');
2153 1 50       377130 if ($response->is_success()) {
2154 1         20 my @closed_list = split(/\n/, $response->decoded_content);
2155 1         693 CLOSED: foreach my $closed (@closed_list) {
2156 128         318 delete($by_db{$closed});
2157             }
2158             }
2159              
2160             # Now merge in the reverse, so you can look up by domain as well as db
2161 1         3 my %by_domain;
2162 1         8 while (my ($key, $value) = each %by_db) {
2163 737         2983 $by_domain{$value} = $key;
2164             }
2165 1         1719 %by_db = (%by_db, %by_domain);
2166              
2167             # This could be saved to disk with Storable. Next time you call this
2168             # method, if mtime is less than, say, 14d, you could load it from
2169             # disk instead of over network.
2170 1         216 $self->{sitematrix} = \%by_db;
2171              
2172 1         1284 return $self->{sitematrix};
2173             }
2174              
2175             sub _get_ns_data {
2176 15     15   32 my $self = shift;
2177              
2178             # If we have it already, return the cached data
2179 15 100       94 return $self->{ns_data} if exists $self->{ns_data};
2180              
2181             # If we haven't returned by now, we have to ask the API
2182 4         24 my %ns_data = $self->get_namespace_names();
2183 4         374 my %reverse = reverse %ns_data;
2184 4         212 %ns_data = (%ns_data, %reverse);
2185 4         62 $self->{ns_data} = \%ns_data; # Save for later use
2186              
2187 4         36 return $self->{ns_data};
2188             }
2189              
2190             sub _get_ns_alias_data {
2191 3     3   6103 my $self = shift;
2192              
2193 3 100       18 return $self->{ns_alias_data} if exists $self->{ns_alias_data};
2194              
2195 2         23 my $ns_res = $self->{api}->api({
2196             action => 'query',
2197             meta => 'siteinfo',
2198             siprop => 'namespacealiases|namespaces',
2199             });
2200              
2201 8         36 my %ns_alias_data =
2202             map { # Map namespace alias names like "WP" to the canonical namespace name
2203             # from the "namespaces" part of the response
2204 8         61 $_->{ns_alias} => $ns_res->{query}->{namespaces}->{ $_->{ns_number} }->{canonical}
2205             }
2206             map { # Map namespace alias names (from the "namespacealiases" part of the response)
2207             # like "WP" to the namespace number (usd to look up canonical data in the
2208             # "namespaces" part of the response)
2209 2         10 { ns_alias => $_->{'*'}, ns_number => $_->{id} }
2210 2         386387 } @{ $ns_res->{query}->{namespacealiases} };
2211              
2212 2         20 $self->{ns_alias_data} = \%ns_alias_data;
2213 2         57 return $self->{ns_alias_data};
2214             }
2215              
2216              
2217             1;
2218              
2219             __END__
2220              
2221             =pod
2222              
2223             =encoding UTF-8
2224              
2225             =head1 NAME
2226              
2227             MediaWiki::Bot - a high-level bot framework for interacting with MediaWiki wikis
2228              
2229             =head1 VERSION
2230              
2231             version 5.006000
2232              
2233             =head1 SYNOPSIS
2234              
2235             use MediaWiki::Bot qw(:constants);
2236              
2237             my $bot = MediaWiki::Bot->new({
2238             assert => 'bot',
2239             host => 'de.wikimedia.org',
2240             login_data => { username => "Mike's bot account", password => "password" },
2241             });
2242              
2243             my $revid = $bot->get_last("User:Mike.lifeguard/sandbox", "Mike.lifeguard");
2244             print "Reverting to $revid\n" if defined($revid);
2245             $bot->revert('User:Mike.lifeguard', $revid, 'rvv');
2246              
2247             =head1 DESCRIPTION
2248              
2249             B<MediaWiki::Bot> is a framework that can be used to write bots which interface
2250             with the MediaWiki API (L<http://en.wikipedia.org/w/api.php>).
2251              
2252             =head1 METHODS
2253              
2254             =head2 new
2255              
2256             my $bot = MediaWiki::Bot({
2257             host => 'en.wikipedia.org',
2258             operator => 'Mike.lifeguard',
2259             });
2260              
2261             Calling C<< MediaWiki::Bot->new() >> will create a new MediaWiki::Bot object. The
2262             only parameter is a hashref with keys:
2263              
2264             =over 4
2265              
2266             =item *
2267              
2268             I<agent> sets a custom useragent. It is recommended to use C<operator>
2269             instead, which is all we need to do the right thing for you. If you really
2270             want to do it yourself, see L<https://meta.wikimedia.org/wiki/User-agent_policy>
2271             for guidance on what information must be included.
2272              
2273             =item *
2274              
2275             I<assert> sets a parameter for the AssertEdit extension (commonly 'bot')
2276              
2277             Refer to L<http://mediawiki.org/wiki/Extension:AssertEdit>.
2278              
2279             =item *
2280              
2281             I<operator> allows the bot to send you a message when it fails an assert. This
2282             is also the recommended way to customize the user agent string, which is
2283             required by the Wikimedia Foundation. A warning will be emitted if you omit
2284             this.
2285              
2286             =item *
2287              
2288             I<maxlag> allows you to set the maxlag parameter (default is the recommended 5s).
2289              
2290             Please refer to the MediaWiki documentation prior to changing this from the
2291             default.
2292              
2293             =item *
2294              
2295             I<protocol> allows you to specify 'http' or 'https' (default is 'http')
2296              
2297             =item *
2298              
2299             I<host> sets the domain name of the wiki to connect to
2300              
2301             =item *
2302              
2303             I<path> sets the path to api.php (with no leading or trailing slash)
2304              
2305             =item *
2306              
2307             I<login_data> is a hashref of credentials to pass to L</login>.
2308              
2309             =item *
2310              
2311             I<debug> - whether to provide debug output.
2312              
2313             1 provides only error messages; 2 provides further detail on internal operations.
2314              
2315             =back
2316              
2317             For example:
2318              
2319             my $bot = MediaWiki::Bot->new({
2320             assert => 'bot',
2321             protocol => 'https',
2322             host => 'en.wikimedia.org',
2323             agent => sprintf(
2324             'PerlWikiBot/%s (https://metacpan.org/MediaWiki::Bot; User:Mike.lifeguard)',
2325             MediaWiki::Bot->VERSION
2326             ),
2327             login_data => { username => "Mike's bot account", password => "password" },
2328             });
2329              
2330             For backward compatibility, you can specify up to three parameters:
2331              
2332             my $bot = MediaWiki::Bot->new('My custom useragent string', $assert, $operator);
2333              
2334             B<This form is deprecated> will never do auto-login or autoconfiguration, and emits
2335             deprecation warnings.
2336              
2337             =head2 set_wiki
2338              
2339             Set what wiki to use. The parameter is a hashref with keys:
2340              
2341             =over 4
2342              
2343             =item *
2344              
2345             I<host> - the domain name
2346              
2347             =item *
2348              
2349             I<path> - the part of the path before api.php (usually 'w')
2350              
2351             =item *
2352              
2353             I<protocol> is either 'http' or 'https'.
2354              
2355             =back
2356              
2357             If you don't set any parameter, it's previous value is used. If it has never
2358             been set, the default settings are 'http', 'en.wikipedia.org' and 'w'.
2359              
2360             For example:
2361              
2362             $bot->set_wiki({
2363             protocol => 'https',
2364             host => 'secure.wikimedia.org',
2365             path => 'wikipedia/meta/w',
2366             });
2367              
2368             For backward compatibility, you can specify up to two parameters:
2369              
2370             $bot->set_wiki($host, $path);
2371              
2372             B<This form is deprecated>, and will emit deprecation warnings.
2373              
2374             =head2 login
2375              
2376             This method takes a hashref with keys I<username> and I<password> at a minimum.
2377             See L</"Single User Login"> and L</"Basic authentication"> for additional options.
2378              
2379             Logs the use $username in, optionally using $password. First, an attempt will be
2380             made to use cookies to log in. If this fails, an attempt will be made to use the
2381             password provided to log in, if any. If the login was successful, returns true;
2382             false otherwise.
2383              
2384             $bot->login({
2385             username => $username,
2386             password => $password,
2387             }) or die "Login failed";
2388              
2389             Once logged in, attempt to do some simple auto-configuration. At present, this
2390             consists of:
2391              
2392             =over 4
2393              
2394             =item *
2395              
2396             Warning if the account doesn't have the bot flag, and isn't a sysop account.
2397              
2398             =item *
2399              
2400             Setting an appropriate default assert.
2401              
2402             =back
2403              
2404             You can skip this autoconfiguration by passing C<autoconfig =E<gt> 0>
2405              
2406             For backward compatibility, you can call this as
2407              
2408             $bot->login($username, $password);
2409              
2410             B<This form is deprecated>, and will emit deprecation warnings. It will
2411             never do autoconfiguration or SUL login.
2412              
2413             =head3 Single User Login
2414              
2415             On WMF wikis, C<do_sul> specifies whether to log in on all projects. The default
2416             is false. But even when false, you still get a CentralAuth cookie for, and are
2417             thus logged in on, all languages of a given domain (C<*.wikipedia.org>, for example).
2418             When set, a login is done on each WMF domain so you are logged in on all ~800
2419             content wikis. Since C<*.wikimedia.org> is not possible, we explicitly include
2420             meta, commons, incubator, and wikispecies.
2421              
2422             =head3 Basic authentication
2423              
2424             If you need to supply basic auth credentials, pass a hashref of data as
2425             described by L<LWP::UserAgent>:
2426              
2427             $bot->login({
2428             username => $username,
2429             password => $password,
2430             basic_auth => { netloc => "private.wiki.com:80",
2431             realm => "Authentication Realm",
2432             uname => "Basic auth username",
2433             pass => "password",
2434             }
2435             }) or die "Couldn't log in";
2436              
2437             =head2 logout
2438              
2439             $bot->logout();
2440              
2441             The logout method logs the bot out of the wiki. This invalidates all login
2442             cookies.
2443              
2444             =head2 edit
2445              
2446             my $text = $bot->get_text('My page');
2447             $text .= "\n\n* More text\n";
2448             $bot->edit({
2449             page => 'My page',
2450             text => $text,
2451             summary => 'Adding new content',
2452             section => 'new',
2453             });
2454              
2455             This method edits a wiki page, and takes a hashref of data with keys:
2456              
2457             =over 4
2458              
2459             =item *
2460              
2461             I<page> - the page title to edit
2462              
2463             =item *
2464              
2465             I<text> - the page text to write
2466              
2467             =item *
2468              
2469             I<summary> - an edit summary
2470              
2471             =item *
2472              
2473             I<minor> - whether to mark the edit as minor or not (boolean)
2474              
2475             =item *
2476              
2477             I<bot> - whether to mark the edit as a bot edit (boolean)
2478              
2479             =item *
2480              
2481             I<assertion> - usually 'bot', but see L<http://mediawiki.org/wiki/Extension:AssertEdit>.
2482              
2483             =item *
2484              
2485             I<section> - edit a single section (identified by number) instead of the whole page
2486              
2487             =back
2488              
2489             An MD5 hash is sent to guard against data corruption while in transit.
2490              
2491             You can also call this as:
2492              
2493             $bot->edit($page, $text, $summary, $is_minor, $assert, $markasbot);
2494              
2495             B<This form is deprecated>, and will emit deprecation warnings.
2496              
2497             =head3 CAPTCHAs
2498              
2499             If a L<https://en.wikipedia.org/wiki/CAPTCHA|CAPTCHA> is encountered, the
2500             call to C<edit> will return false, with the error code set to C<ERR_CAPTCHA>
2501             and the details informing you that solving a CAPTCHA is required for this
2502             action. The information you need to actually solve the captcha (for example
2503             the URL for the image) is given in C<< $bot->{error}->{captcha} >> as a
2504             hash reference. You will want to grab the keys 'url' (a relative URL to
2505             the image) and 'id' (the ID of the CAPTCHA). Once you have solved the
2506             CAPTCHA (presumably by interacting with a human), retry the edit, adding
2507             C<captcha_id> and C<captcha_solution> parameters:
2508              
2509             my $edit_status = $bot->edit({page => 'Main Page', text => 'got your nose'});
2510             if (not $edit_status) {
2511             if ($bot->{error}->{code} == ERR_CAPTCHA) {
2512             my @captcha_uri = split /\Q?/, $bot->{error}{captcha}{url}, 2;
2513             my $image = URI->new(sprintf '%s://%s%s?%s' =>
2514             $bot->{protocol}, $bot->{host}, $captcha_uri[0], $captcha_uri[1],
2515             );
2516              
2517             require Term::ReadLine;
2518             my $term = Term::ReadLine->new('Solve the captcha');
2519             $term->ornaments(0);
2520             my $answer = $term->readline("Please solve $image and type the answer: ");
2521              
2522             # Add new CAPTCHA params to the edit we're attempting
2523             $edit->{captcha_id} = $bot->{error}->{captcha}->{id};
2524             $edit->{captcha_solution} = $answer;
2525             $status = $bot->edit($edit);
2526             }
2527             }
2528              
2529             =head2 move
2530              
2531             $bot->move($from_title, $to_title, $reason, $options_hashref);
2532              
2533             This moves a wiki page.
2534              
2535             If you wish to specify more options (like whether to suppress creation of a
2536             redirect), use $options_hashref, which has keys:
2537              
2538             =over 4
2539              
2540             =item *
2541              
2542             I<movetalk> specifies whether to attempt to the talk page.
2543              
2544             =item *
2545              
2546             I<noredirect> specifies whether to suppress creation of a redirect.
2547              
2548             =item *
2549              
2550             I<movesubpages> specifies whether to move subpages, if applicable.
2551              
2552             =item *
2553              
2554             I<watch> and I<unwatch> add or remove the page and the redirect from your watchlist.
2555              
2556             =item *
2557              
2558             I<ignorewarnings> ignores warnings.
2559              
2560             =back
2561              
2562             my @pages = ("Humor", "Rumor");
2563             foreach my $page (@pages) {
2564             my $to = $page;
2565             $to =~ s/or$/our/;
2566             $bot->move($page, $to, "silly 'merricans");
2567             }
2568              
2569             =head2 get_history
2570              
2571             my @hist = $bot->get_history($title, $limit, $revid, $direction);
2572              
2573             Returns an array containing the history of the specified $page_title, with
2574             $limit number of revisions (default is as many as possible).
2575              
2576             The array returned contains hashrefs with keys: revid, user, comment, minor,
2577             timestamp_date, and timestamp_time.
2578              
2579             =head2 get_text
2580              
2581             Returns an the wikitext of the specified $page_title. The second parameter is
2582             $revid - if defined, returns the text of that revision; the third is
2583             $section_number - if defined, returns the text of that section.
2584              
2585             A blank page will return wikitext of "" (which evaluates to false in Perl,
2586             but is defined); a nonexistent page will return undef (which also evaluates
2587             to false in Perl, but is obviously undefined). You can distinguish between
2588             blank and nonexistent pages by using L<defined|perlfunc/defined>:
2589              
2590             my $wikitext = $bot->get_text('Page title');
2591             print "Wikitext: $wikitext\n" if defined $wikitext;
2592              
2593             =head2 get_id
2594              
2595             Returns the id of the specified $page_title. Returns undef if page does not exist.
2596              
2597             my $pageid = $bot->get_id("Main Page");
2598             die "Page doesn't exist\n" if !defined($pageid);
2599              
2600             =head2 get_pages
2601              
2602             Returns the text of the specified pages in a hashref. Content of undef means
2603             page does not exist. Also handles redirects or article names that use namespace
2604             aliases.
2605              
2606             my @pages = ('Page 1', 'Page 2', 'Page 3');
2607             my $thing = $bot->get_pages(\@pages);
2608             foreach my $page (keys %$thing) {
2609             my $text = $thing->{$page};
2610             print "$text\n" if defined($text);
2611             }
2612              
2613             =head2 get_image
2614              
2615             $buffer = $bot->get_image('File:Foo.jpg', {width=>256, height=>256});
2616              
2617             Download an image from a wiki. This is derived from a similar function in
2618             L<MediaWiki::API>. This one allows the image to be scaled down by passing a hashref
2619             with height & width parameters.
2620              
2621             It returns raw data in the original format. You may simply spew it to a file, or
2622             process it directly with a library such as L<Imager>.
2623              
2624             use File::Slurp qw(write_file);
2625             my $img_data = $bot->get_image('File:Foo.jpg');
2626             write_file( 'Foo.jpg', {binmode => ':raw'}, \$img_data );
2627              
2628             Images are scaled proportionally. (height/width) will remain
2629             constant, except for rounding errors.
2630              
2631             Height and width parameters describe the B<maximum> dimensions. A 400x200
2632             image will never be scaled to greater dimensions. You can scale it yourself;
2633             having the wiki do it is just lazy & selfish.
2634              
2635             =head2 revert
2636              
2637             Reverts the specified $page_title to $revid, with an edit summary of $summary. A
2638             default edit summary will be used if $summary is omitted.
2639              
2640             my $revid = $bot->get_last("User:Mike.lifeguard/sandbox", "Mike.lifeguard");
2641             print "Reverting to $revid\n" if defined($revid);
2642             $bot->revert('User:Mike.lifeguard', $revid, 'rvv');
2643              
2644             =head2 undo
2645              
2646             $bot->undo($title, $revid, $summary, $after);
2647              
2648             Reverts the specified $revid, with an edit summary of $summary, using the undo
2649             function. To undo all revisions from $revid up to but not including this one,
2650             set $after to another revid. If not set, just undo the one revision ($revid).
2651              
2652             See L<http://www.mediawiki.org/wiki/API:Edit#Parameters>.
2653              
2654             =head2 get_last
2655              
2656             Returns the revid of the last revision to $page not made by $user. undef is
2657             returned if no result was found, as would be the case if the page is deleted.
2658              
2659             my $revid = $bot->get_last('User:Mike.lifeguard/sandbox', 'Mike.lifeguard');
2660             if defined($revid) {
2661             print "Reverting to $revid\n";
2662             $bot->revert('User:Mike.lifeguard', $revid, 'rvv');
2663             }
2664              
2665             =head2 update_rc
2666              
2667             B<This method is deprecated>, and will emit deprecation warnings.
2668             Replace calls to C<update_rc()> with calls to the newer C<recentchanges()>, which
2669             returns all available data, including rcid.
2670              
2671             Returns an array containing the $limit most recent changes to the wiki's I<main
2672             namespace>. The array contains hashrefs with keys title, revid, old_revid,
2673             and timestamp.
2674              
2675             my @rc = $bot->update_rc(5);
2676             foreach my $hashref (@rc) {
2677             my $title = $hash->{'title'};
2678             print "$title\n";
2679             }
2680              
2681             The L</"Options hashref"> is also available:
2682              
2683             # Use a callback for incremental processing:
2684             my $options = { hook => \&mysub, };
2685             $bot->update_rc($options);
2686             sub mysub {
2687             my ($res) = @_;
2688             foreach my $hashref (@$res) {
2689             my $page = $hashref->{'title'};
2690             print "$page\n";
2691             }
2692             }
2693              
2694             =head2 recentchanges($wiki_hashref, $options_hashref)
2695              
2696             Returns an array of hashrefs containing recentchanges data.
2697              
2698             The first parameter is a hashref with the following keys:
2699              
2700             =over 4
2701              
2702             =item I<ns> - the namespace number, or an arrayref of numbers to
2703             specify several; default is the main namespace
2704              
2705             =item I<limit> - the number of rows to fetch; default is 50
2706              
2707             =item I<user> - only list changes by this user
2708              
2709             =item I<show> - itself a hashref where the key is a category and the value is
2710             a boolean. If true, the category will be included; if false, excluded. The
2711             categories are kinds of edits: minor, bot, anon, redirect, patrolled. See
2712             "rcshow" at L<http://www.mediawiki.org/wiki/API:Recentchanges#Parameters>.
2713              
2714             =back
2715              
2716             An L</"Options hashref"> can be used as the second parameter:
2717              
2718             my @rc = $bot->recentchanges({ ns => 4, limit => 100 });
2719             foreach my $hashref (@rc) {
2720             print $hashref->{title} . "\n";
2721             }
2722              
2723             # Or, use a callback for incremental processing:
2724             $bot->recentchanges({ ns => [0,1], limit => 500 }, { hook => \&mysub });
2725             sub mysub {
2726             my ($res) = @_;
2727             foreach my $hashref (@$res) {
2728             my $page = $hashref->{title};
2729             print "$page\n";
2730             }
2731             }
2732              
2733             The hashref returned might contain the following keys:
2734              
2735             =over 4
2736              
2737             =item I<ns> - the namespace number
2738              
2739             =item I<revid>
2740              
2741             =item I<old_revid>
2742              
2743             =item I<timestamp>
2744              
2745             =item I<rcid> - can be used with L</patrol>
2746              
2747             =item I<pageid>
2748              
2749             =item I<type> - one of edit, new, log (there may be others)
2750              
2751             =item I<title>
2752              
2753             =back
2754              
2755             For backwards compatibility, the previous method signature is still
2756             supported:
2757              
2758             $bot->recentchanges($ns, $limit, $options_hashref);
2759              
2760             =head2 what_links_here
2761              
2762             Returns an array containing a list of all pages linking to $page.
2763              
2764             Additional optional parameters are:
2765              
2766             =over 4
2767              
2768             =item *
2769              
2770             One of: all (default), redirects, or nonredirects.
2771              
2772             =item *
2773              
2774             A namespace number to search (pass an arrayref to search in multiple namespaces)
2775              
2776             =item *
2777              
2778             An L</"Options hashref">.
2779              
2780             =back
2781              
2782             A typical query:
2783              
2784             my @links = $bot->what_links_here("Meta:Sandbox",
2785             undef, 1,
2786             { hook=>\&mysub }
2787             );
2788             sub mysub{
2789             my ($res) = @_;
2790             foreach my $hash (@$res) {
2791             my $title = $hash->{'title'};
2792             my $is_redir = $hash->{'redirect'};
2793             print "Redirect: $title\n" if $is_redir;
2794             print "Page: $title\n" unless $is_redir;
2795             }
2796             }
2797              
2798             Transclusions are no longer handled by what_links_here() - use
2799             L</list_transclusions> instead.
2800              
2801             =head2 list_transclusions
2802              
2803             Returns an array containing a list of all pages transcluding $page.
2804              
2805             Other parameters are:
2806              
2807             =over 4
2808              
2809             =item *
2810              
2811             One of: all (default), redirects, or nonredirects
2812              
2813             =item *
2814              
2815             A namespace number to search (pass an arrayref to search in multiple namespaces).
2816              
2817             =item *
2818              
2819             $options_hashref as described by L<MediaWiki::API>:
2820              
2821             Set max to limit the number of queries performed.
2822              
2823             Set hook to a subroutine reference to use a callback hook for incremental
2824             processing.
2825              
2826             Refer to the section on L</linksearch> for examples.
2827              
2828             =back
2829              
2830             A typical query:
2831              
2832             $bot->list_transclusions("Template:Tlx", undef, 4, {hook => \&mysub});
2833             sub mysub{
2834             my ($res) = @_;
2835             foreach my $hash (@$res) {
2836             my $title = $hash->{'title'};
2837             my $is_redir = $hash->{'redirect'};
2838             print "Redirect: $title\n" if $is_redir;
2839             print "Page: $title\n" unless $is_redir;
2840             }
2841             }
2842              
2843             =head2 get_pages_in_category
2844              
2845             Returns an array containing the names of all pages in the specified category
2846             (include the Category: prefix). Does not recurse into sub-categories.
2847              
2848             my @pages = $bot->get_pages_in_category('Category:People on stamps of Gabon');
2849             print "The pages in Category:People on stamps of Gabon are:\n@pages\n";
2850              
2851             The options hashref is as described in L</"Options hashref">.
2852             Use C<< { max => 0 } >> to get all results.
2853              
2854             =head2 get_all_pages_in_category
2855              
2856             my @pages = $bot->get_all_pages_in_category($category, $options_hashref);
2857              
2858             Returns an array containing the names of B<all> pages in the specified category
2859             (include the Category: prefix), including sub-categories. The $options_hashref
2860             is described fully in L</"Options hashref">.
2861              
2862             =head2 get_all_categories
2863              
2864             Returns an array containing the names of all categories.
2865              
2866             my @categories = $bot->get_all_categories();
2867             print "The categories are:\n@categories\n";
2868              
2869             Use C<< { max => 0 } >> to get all results. The default number
2870             of categories returned is 10, the maximum allowed is 500.
2871              
2872             =head2 linksearch
2873              
2874             Runs a linksearch on the specified $link and returns an array containing
2875             anonymous hashes with keys 'url' for the outbound URL, and 'title' for the page
2876             the link is on.
2877              
2878             Additional parameters are:
2879              
2880             =over 4
2881              
2882             =item *
2883              
2884             A namespace number to search (pass an arrayref to search in multiple namespaces).
2885              
2886             =item *
2887              
2888             You can search by $protocol (http is default).
2889              
2890             =item *
2891              
2892             $options_hashref is fully documented in L</"Options hashref">:
2893              
2894             Set I<max> in $options to get more than one query's worth of results:
2895              
2896             my $options = { max => 10, }; # I only want some results
2897             my @links = $bot->linksearch("slashdot.org", 1, undef, $options);
2898             foreach my $hash (@links) {
2899             my $url = $hash->{'url'};
2900             my $page = $hash->{'title'};
2901             print "$page: $url\n";
2902             }
2903              
2904             Set I<hook> to a subroutine reference to use a callback hook for incremental
2905             processing:
2906              
2907             my $options = { hook => \&mysub, }; # I want to do incremental processing
2908             $bot->linksearch("slashdot.org", 1, undef, $options);
2909             sub mysub {
2910             my ($res) = @_;
2911             foreach my $hashref (@$res) {
2912             my $url = $hashref->{'url'};
2913             my $page = $hashref->{'title'};
2914             print "$page: $url\n";
2915             }
2916             }
2917              
2918             =back
2919              
2920             =head2 purge_page
2921              
2922             Purges the server cache of the specified $page. Returns true on success; false
2923             on failure. Pass an array reference to purge multiple pages.
2924              
2925             If you really care, a true return value is the number of pages successfully
2926             purged. You could check that it is the same as the number you wanted to
2927             purge - maybe some pages don't exist, or you passed invalid titles, or you
2928             aren't allowed to purge the cache:
2929              
2930             my @to_purge = ('Main Page', 'A', 'B', 'C', 'Very unlikely to exist');
2931             my $size = scalar @to_purge;
2932              
2933             print "all-at-once:\n";
2934             my $success = $bot->purge_page(\@to_purge);
2935              
2936             if ($success == $size) {
2937             print "@to_purge: OK ($success/$size)\n";
2938             }
2939             else {
2940             my $missed = @to_purge - $success;
2941             print "We couldn't purge $missed pages (list was: "
2942             . join(', ', @to_purge)
2943             . ")\n";
2944             }
2945              
2946             # OR
2947             print "\n\none-at-a-time:\n";
2948             foreach my $page (@to_purge) {
2949             my $ok = $bot->purge_page($page);
2950             print "$page: $ok\n";
2951             }
2952              
2953             =head2 get_namespace_names
2954              
2955             my %namespace_names = $bot->get_namespace_names();
2956              
2957             Returns a hash linking the namespace id, such as 1, to its named equivalent,
2958             such as "Talk".
2959              
2960             =head2 image_usage
2961              
2962             Gets a list of pages which include a certain $image. Include the C<File:>
2963             namespace prefix to avoid incurring an extra round-trip (which will also emit
2964             a deprecation warnings).
2965              
2966             Additional parameters are:
2967              
2968             =over 4
2969              
2970             =item *
2971              
2972             A namespace number to fetch results from (or an arrayref of multiple namespace
2973             numbers)
2974              
2975             =item *
2976              
2977             One of all, redirect, or nonredirects.
2978              
2979             =item *
2980              
2981             $options is a hashref as described in the section for L</linksearch>.
2982              
2983             =back
2984              
2985             my @pages = $bot->image_usage("File:Albert Einstein Head.jpg");
2986              
2987             Or, make use of the L</"Options hashref"> to do incremental processing:
2988              
2989             $bot->image_usage("File:Albert Einstein Head.jpg",
2990             undef, undef,
2991             { hook=>\&mysub, max=>5 }
2992             );
2993             sub mysub {
2994             my $res = shift;
2995             foreach my $page (@$res) {
2996             my $title = $page->{'title'};
2997             print "$title\n";
2998             }
2999             }
3000              
3001             =head2 global_image_usage($image, $results, $filterlocal)
3002              
3003             Returns an array of hashrefs of data about pages which use the given image.
3004              
3005             my @data = $bot->global_image_usage('File:Albert Einstein Head.jpg');
3006              
3007             The keys in each hashref are title, url, and wiki. C<$results> is the maximum
3008             number of results that will be returned (not the maximum number of requests that
3009             will be sent, like C<max> in the L</"Options hashref">); the default is to
3010             attempt to fetch 500 (set to 0 to get all results). C<$filterlocal> will filter
3011             out local uses of the image.
3012              
3013             =head2 links_to_image
3014              
3015             A backward-compatible call to L</image_usage>. You can provide only the image
3016             title.
3017              
3018             B<This method is deprecated>, and will emit deprecation warnings.
3019              
3020             =head2 is_blocked
3021              
3022             my $blocked = $bot->is_blocked('User:Mike.lifeguard');
3023              
3024             Checks if a user is currently blocked.
3025              
3026             =head2 test_blocked
3027              
3028             Retained for backwards compatibility. Use L</is_blocked> for clarity.
3029              
3030             B<This method is deprecated>, and will emit deprecation warnings.
3031              
3032             =head2 test_image_exists
3033              
3034             Checks if an image exists at $page.
3035              
3036             =over 4
3037              
3038             =item *
3039              
3040             FILE_NONEXISTENT (0) means "Nothing there"
3041              
3042             =item *
3043              
3044             FILE_LOCAL (1) means "Yes, an image exists locally"
3045              
3046             =item *
3047              
3048             FILE_SHARED (2) means "Yes, an image exists on L<Commons|http://commons.wikimedia.org>"
3049              
3050             =item *
3051              
3052             FILE_PAGE_TEXT_ONLY (3) means "No image exists, but there is text on the page"
3053              
3054             =back
3055              
3056             If you pass in an arrayref of images, you'll get out an arrayref of
3057             results.
3058              
3059             use MediaWiki::Bot::Constants;
3060             my $exists = $bot->test_image_exists('File:Albert Einstein Head.jpg');
3061             if ($exists == FILE_NONEXISTENT) {
3062             print "Doesn't exist\n";
3063             }
3064             elsif ($exists == FILE_LOCAL) {
3065             print "Exists locally\n";
3066             }
3067             elsif ($exists == FILE_SHARED) {
3068             print "Exists on Commons\n";
3069             }
3070             elsif ($exists == FILE_PAGE_TEXT_ONLY) {
3071             print "Page exists, but no image\n";
3072             }
3073              
3074             =head2 get_pages_in_namespace
3075              
3076             $bot->get_pages_in_namespace($namespace, $limit, $options_hashref);
3077              
3078             Returns an array containing the names of all pages in the specified namespace.
3079             The $namespace_id must be a number, not a namespace name.
3080              
3081             Setting $page_limit is optional, and specifies how many items to retrieve at
3082             once. Setting this to 'max' is recommended, and this is the default if omitted.
3083             If $page_limit is over 500, it will be rounded up to the next multiple of 500.
3084             If $page_limit is set higher than you are allowed to use, it will silently be
3085             reduced. Consider setting key 'max' in the L</"Options hashref"> to
3086             retrieve multiple sets of results:
3087              
3088             # Gotta get 'em all!
3089             my @pages = $bot->get_pages_in_namespace(6, 'max', { max => 0 });
3090              
3091             =head2 count_contributions
3092              
3093             my $count = $bot->count_contributions($user);
3094              
3095             Uses the API to count $user's contributions.
3096              
3097             =head2 timed_count_contributions
3098              
3099             ($timed_edits_count, $total_count) = $bot->timed_count_contributions($user, $days);
3100              
3101             Uses the API to count $user's contributions in last number of $days and total number of user's contributions (if needed).
3102              
3103             Example: If you want to get user contribs for last 30 and 365 days, and total number of edits you would write
3104             something like this:
3105              
3106             my ($last30days, $total) = $bot->timed_count_contributions($user, 30);
3107             my $last365days = $bot->timed_count_contributions($user, 365);
3108              
3109             You could get total number of edits also by separately calling count_contributions like this:
3110              
3111             my $total = $bot->count_contributions($user);
3112              
3113             and use timed_count_contributions only in scalar context, but that would mean one more call to server (meaning more
3114             server load) of which you are excused as timed_count_contributions returns array with two parameters.
3115              
3116             =head2 last_active
3117              
3118             my $latest_timestamp = $bot->last_active($user);
3119              
3120             Returns the last active time of $user in C<YYYY-MM-DDTHH:MM:SSZ>.
3121              
3122             =head2 recent_edit_to_page
3123              
3124             my ($timestamp, $user) = $bot->recent_edit_to_page($title);
3125              
3126             Returns timestamp and username for most recent (top) edit to $page.
3127              
3128             =head2 get_users
3129              
3130             my @recent_editors = $bot->get_users($title, $limit, $revid, $direction);
3131              
3132             Gets the most recent editors to $page, up to $limit, starting from $revision
3133             and going in $direction.
3134              
3135             =head2 was_blocked
3136              
3137             for ("Mike.lifeguard", "Jimbo Wales") {
3138             print "$_ was blocked\n" if $bot->was_blocked($_);
3139             }
3140              
3141             Returns whether $user has ever been blocked.
3142              
3143             =head2 test_block_hist
3144              
3145             Retained for backwards compatibility. Use L</was_blocked> for clarity.
3146              
3147             B<This method is deprecated>, and will emit deprecation warnings.
3148              
3149             =head2 expandtemplates
3150              
3151             my $expanded = $bot->expandtemplates($title, $wikitext);
3152              
3153             Expands templates on $page, using $text if provided, otherwise loading the page
3154             text automatically.
3155              
3156             =head2 get_allusers
3157              
3158             my @users = $bot->get_allusers($limit, $user_group, $options_hashref);
3159              
3160             Returns an array of all users. Default $limit is 500. Optionally specify a
3161             $group (like 'sysop') to list that group only. The last optional parameter
3162             is an L</"Options hashref">.
3163              
3164             =head2 db_to_domain
3165              
3166             Converts a wiki/database name (enwiki) to the domain name (en.wikipedia.org).
3167              
3168             my @wikis = ("enwiki", "kowiki", "bat-smgwiki", "nonexistent");
3169             foreach my $wiki (@wikis) {
3170             my $domain = $bot->db_to_domain($wiki);
3171             next if !defined($domain);
3172             print "$wiki: $domain\n";
3173             }
3174              
3175             You can pass an arrayref to do bulk lookup:
3176              
3177             my @wikis = ("enwiki", "kowiki", "bat-smgwiki", "nonexistent");
3178             my $domains = $bot->db_to_domain(\@wikis);
3179             foreach my $domain (@$domains) {
3180             next if !defined($domain);
3181             print "$domain\n";
3182             }
3183              
3184             =head2 domain_to_db
3185              
3186             my $db = $bot->domain_to_db($domain_name);
3187              
3188             As you might expect, does the opposite of L</domain_to_db>: Converts a domain
3189             name (meta.wikimedia.org) into a database/wiki name (metawiki).
3190              
3191             =head2 diff
3192              
3193             This allows retrieval of a diff from the API. The return is a scalar containing
3194             the I<HTML table> of the diff. Options are passed as a hashref with keys:
3195              
3196             =over 4
3197              
3198             =item *
3199              
3200             I<title> is the title to use. Provide I<either> this or revid.
3201              
3202             =item *
3203              
3204             I<revid> is any revid to diff from. If you also specified title, only title will
3205             be honoured.
3206              
3207             =item *
3208              
3209             I<oldid> is an identifier to diff to. This can be a revid, or the special values
3210             'cur', 'prev' or 'next'
3211              
3212             =back
3213              
3214             =head2 prefixindex
3215              
3216             This returns an array of hashrefs containing page titles that start with the
3217             given $prefix. The hashref has keys 'title' and 'redirect' (present if the
3218             page is a redirect, not present otherwise).
3219              
3220             Additional parameters are:
3221              
3222             =over 4
3223              
3224             =item *
3225              
3226             One of all, redirects, or nonredirects
3227              
3228             =item *
3229              
3230             A single namespace number (unlike linksearch etc, which can accept an arrayref
3231             of numbers).
3232              
3233             =item *
3234              
3235             $options_hashref as described in L</"Options hashref">.
3236              
3237             =back
3238              
3239             my @prefix_pages = $bot->prefixindex("User:Mike.lifeguard");
3240             # Or, the more efficient equivalent
3241             my @prefix_pages = $bot->prefixindex("Mike.lifeguard", 2);
3242             foreach my $hashref (@pages) {
3243             my $title = $hashref->{'title'};
3244             if $hashref->{'redirect'} {
3245             print "$title is a redirect\n";
3246             }
3247             else {
3248             print "$title\n is not a redirect\n";
3249             }
3250             }
3251              
3252             =head2 search
3253              
3254             This is a simple search for your $search_term in page text. It returns an array
3255             of page titles matching.
3256              
3257             Additional optional parameters are:
3258              
3259             =over 4
3260              
3261             =item *
3262              
3263             A namespace number to search in, or an arrayref of numbers (default is the
3264             main namespace)
3265              
3266             =item *
3267              
3268             $options_hashref is a hashref as described in L</"Options hashref">:
3269              
3270             =back
3271              
3272             my @pages = $bot->search("Mike.lifeguard", 2);
3273             print "@pages\n";
3274              
3275             Or, use a callback for incremental processing:
3276              
3277             my @pages = $bot->search("Mike.lifeguard", 2, { hook => \&mysub });
3278             sub mysub {
3279             my ($res) = @_;
3280             foreach my $hashref (@$res) {
3281             my $page = $hashref->{'title'};
3282             print "$page\n";
3283             }
3284             }
3285              
3286             =head2 get_log
3287              
3288             This fetches log entries, and returns results as an array of hashes. The first
3289             parameter is a hashref with keys:
3290              
3291             =over 4
3292              
3293             =item *
3294              
3295             I<type> is the log type (block, delete...)
3296              
3297             =item *
3298              
3299             I<user> is the user who I<performed> the action. Do not include the User: prefix
3300              
3301             =item *
3302              
3303             I<target> is the target of the action. Where an action was performed to a page,
3304             it is the page title. Where an action was performed to a user, it is
3305             User:$username.
3306              
3307             =back
3308              
3309             The second is the familiar L</"Options hashref">.
3310              
3311             my $log = $bot->get_log({
3312             type => 'block',
3313             user => 'User:Mike.lifeguard',
3314             });
3315             foreach my $entry (@$log) {
3316             my $user = $entry->{'title'};
3317             print "$user\n";
3318             }
3319              
3320             $bot->get_log({
3321             type => 'block',
3322             user => 'User:Mike.lifeguard',
3323             },
3324             { hook => \&mysub, max => 10 }
3325             );
3326             sub mysub {
3327             my ($res) = @_;
3328             foreach my $hashref (@$res) {
3329             my $title = $hashref->{'title'};
3330             print "$title\n";
3331             }
3332             }
3333              
3334             =head2 is_g_blocked
3335              
3336             my $is_globally_blocked = $bot->is_g_blocked('127.0.0.1');
3337              
3338             Returns what IP/range block I<currently in place> affects the IP/range. The
3339             return is a scalar of an IP/range if found (evaluates to true in boolean
3340             context); undef otherwise (evaluates false in boolean context). Pass in a
3341             single IP or CIDR range.
3342              
3343             =head2 was_g_blocked
3344              
3345             print "127.0.0.1 was globally blocked\n" if $bot->was_g_blocked('127.0.0.1');
3346              
3347             Returns whether an IP/range was ever globally blocked. You should probably
3348             call this method only when your bot is operating on Meta - this method will
3349             warn if not.
3350              
3351             =head2 was_locked
3352              
3353             my $was_locked = $bot->was_locked('Mike.lifeguard');
3354              
3355             Returns whether a user was ever locked. You should probably call this method
3356             only when your bot is operating on Meta - this method will warn if not.
3357              
3358             =head2 get_protection
3359              
3360             Returns data on page protection as a array of up to two hashrefs. Each hashref
3361             has a type, level, and expiry. Levels are 'sysop' and 'autoconfirmed'; types are
3362             'move' and 'edit'; expiry is a timestamp. Additionally, the key 'cascade' will
3363             exist if cascading protection is used.
3364              
3365             my $page = 'Main Page';
3366             $bot->edit({
3367             page => $page,
3368             text => rand(),
3369             summary => 'test',
3370             }) unless $bot->get_protection($page);
3371              
3372             You can also pass an arrayref of page titles to do bulk queries:
3373              
3374             my @pages = ('Main Page', 'User:Mike.lifeguard', 'Project:Sandbox');
3375             my $answer = $bot->get_protection(\@pages);
3376             foreach my $title (keys %$answer) {
3377             my $protected = $answer->{$title};
3378             print "$title is protected\n" if $protected;
3379             print "$title is unprotected\n" unless $protected;
3380             }
3381              
3382             =head2 is_protected
3383              
3384             This is a synonym for L</get_protection>, which should be used in preference.
3385              
3386             B<This method is deprecated>, and will emit deprecation warnings.
3387              
3388             =head2 patrol
3389              
3390             $bot->patrol($rcid);
3391              
3392             Marks a page or revision identified by the $rcid as patrolled. To mark several
3393             RCIDs as patrolled, you may pass an arrayref of them. Returns false and sets
3394             C<< $bot->{error} >> if the account cannot patrol.
3395              
3396             =head2 email
3397              
3398             $bot->email($user, $subject, $body);
3399              
3400             This allows you to send emails through the wiki. All 3 of $user (without the
3401             User: prefix), $subject and $body are required. If $user is an arrayref, this
3402             will send the same email (subject and body) to all users.
3403              
3404             =head2 top_edits
3405              
3406             Returns an array of the page titles where the $user is the latest editor. The
3407             second parameter is the familiar L<$options_hashref|/linksearch>.
3408              
3409             my @pages = $bot->top_edits("Mike.lifeguard", {max => 5});
3410             foreach my $page (@pages) {
3411             $bot->rollback($page, "Mike.lifeguard");
3412             }
3413              
3414             Note that accessing the data with a callback happens B<before> filtering
3415             the top edits is done. For that reason, you should use L</contributions>
3416             if you need to use a callback. If you use a callback with top_edits(),
3417             you B<will not> necessarily get top edits returned. It is only safe to use a
3418             callback if you I<check> that it is a top edit:
3419              
3420             $bot->top_edits("Mike.lifeguard", { hook => \&rv });
3421             sub rv {
3422             my $data = shift;
3423             foreach my $page (@$data) {
3424             if (exists($page->{'top'})) {
3425             $bot->rollback($page->{'title'}, "Mike.lifeguard");
3426             }
3427             }
3428             }
3429              
3430             =head2 contributions
3431              
3432             my @contribs = $bot->contributions($user, $namespace, $options);
3433              
3434             Returns an array of hashrefs of data for the user's contributions. $ns can be an
3435             arrayref of namespace numbers. $options can be specified as in L</linksearch>.
3436              
3437             Specify an arrayref of users to get results for multiple users.
3438              
3439             =head2 upload
3440              
3441             $bot->upload({ data => $file_contents, summary => 'uploading file' });
3442             $bot->upload({ file => $file_name, title => 'Target filename.png' });
3443              
3444             Upload a file to the wiki. Specify the file by either giving the filename, which
3445             will be read in, or by giving the data directly.
3446              
3447             =head2 upload_from_url
3448              
3449             Upload file directly from URL to the wiki. Specify URL, the new filename and summary. Summary and new filename are optional.
3450              
3451             $bot->upload_from_url({ url => 'http://some.domain.ext/pic.png', title => 'Target_filename.png', summary => 'uploading new pic' });
3452              
3453             If on your target wiki is enabled uploading from URL, meaning $wgAllowCopyUploads is set to true in LocalSettings.php and you have
3454             appropriate user rights, you can use this function to upload files to your wiki directly from remote server.
3455              
3456             =head2 usergroups
3457              
3458             Returns a list of the usergroups a user is in:
3459              
3460             my @usergroups = $bot->usergroups('Mike.lifeguard');
3461              
3462             =head2 Options hashref
3463              
3464             This is passed through to the lower-level interface L<MediaWiki::API>, and is
3465             fully documented there.
3466              
3467             The hashref can have 3 keys:
3468              
3469             =over 4
3470              
3471             =item max
3472              
3473             Specifies the maximum number of queries to retrieve data from the wiki. This is
3474             independent of the I<size> of each query (how many items each query returns).
3475             Set to 0 to retrieve all the results.
3476              
3477             =item hook
3478              
3479             Specifies a coderef to a hook function that can be used to process large lists
3480             as they come in. When this is used, your subroutine will get the raw data. This
3481             is noted in cases where it is known to be significant. For example, when
3482             using a hook with C<top_edits()>, you need to check whether the edit is the top
3483             edit yourself - your subroutine gets results as they come in, and before they're
3484             filtered.
3485              
3486             =item skip_encoding
3487              
3488             MediaWiki's API uses UTF-8 and any 8 bit character string parameters are encoded
3489             automatically by the API call. If your parameters are already in UTF-8 this will
3490             be detected and the encoding will be skipped. If your parameters for some reason
3491             contain UTF-8 data but no UTF-8 flag is set (i.e. you did not use the
3492             C<< use L<utf8>; >> pragma) you should prevent re-encoding by passing an option
3493             C<< skip_encoding => 1 >>. For example:
3494              
3495             $category ="Cat\x{e9}gorie:moyen_fran\x{e7}ais"; # latin1 string
3496             $bot->get_all_pages_in_category($category); # OK
3497              
3498             $category = "Cat". pack("U", 0xe9)."gorie:moyen_fran".pack("U",0xe7)."ais"; # unicode string
3499             $bot->get_all_pages_in_category($category); # OK
3500              
3501             $category ="Cat\x{c3}\x{a9}gorie:moyen_fran\x{c3}\x{a7}ais"; # unicode data without utf-8 flag
3502             # $bot->get_all_pages_in_category($category); # NOT OK
3503             $bot->get_all_pages_in_category($category, { skip_encoding => 1 }); # OK
3504              
3505             If you need this, it probably means you're doing something wrong. Feel free to
3506             ask for help.
3507              
3508             =back
3509              
3510             =head1 ERROR HANDLING
3511              
3512             All functions will return undef in any handled error situation. Further error
3513             data is stored in C<< $bot->{error}->{code} >> and C<< $bot->{error}->{details} >>.
3514              
3515             Error codes are provided as constants in L<MediaWiki::Bot::Constants>, and can also
3516             be imported through this module:
3517              
3518             use MediaWiki::Bot qw(:constants);
3519              
3520             =head1 AVAILABILITY
3521              
3522             The project homepage is L<https://metacpan.org/module/MediaWiki::Bot>.
3523              
3524             The latest version of this module is available from the Comprehensive Perl
3525             Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
3526             site near you, or see L<https://metacpan.org/module/MediaWiki::Bot/>.
3527              
3528             =head1 SOURCE
3529              
3530             The development version is on github at L<http://github.com/doherty/MediaWiki-Bot>
3531             and may be cloned from L<git://github.com/doherty/MediaWiki-Bot.git>
3532              
3533             =head1 BUGS AND LIMITATIONS
3534              
3535             You can make new bug reports, and view existing ones, through the
3536             web interface at L<http://rt.cpan.org>.
3537              
3538             =head1 AUTHORS
3539              
3540             =over 4
3541              
3542             =item *
3543              
3544             Dan Collins <dcollins@cpan.org>
3545              
3546             =item *
3547              
3548             Mike.lifeguard <lifeguard@cpan.org>
3549              
3550             =item *
3551              
3552             Alex Rowe <alex.d.rowe@gmail.com>
3553              
3554             =item *
3555              
3556             Oleg Alexandrov <oleg.alexandrov@gmail.com>
3557              
3558             =item *
3559              
3560             jmax.code <jmax.code@gmail.com>
3561              
3562             =item *
3563              
3564             Stefan Petrea <stefan.petrea@gmail.com>
3565              
3566             =item *
3567              
3568             kc2aei <kc2aei@gmail.com>
3569              
3570             =item *
3571              
3572             bosborne@alum.mit.edu
3573              
3574             =item *
3575              
3576             Brian Obio <brianobio@gmail.com>
3577              
3578             =item *
3579              
3580             patch and bug report contributors
3581              
3582             =back
3583              
3584             =head1 COPYRIGHT AND LICENSE
3585              
3586             This software is Copyright (c) 2014 by the MediaWiki::Bot team <perlwikibot@googlegroups.com>.
3587              
3588             This is free software, licensed under:
3589              
3590             The GNU General Public License, Version 3, June 2007
3591              
3592             =cut