| 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 |