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 |