User:AnomieBOT/source/AnomieBOT/API.pm
{{ombox|text=See /doc for formatted documentation}}
package AnomieBOT::API;
use utf8;
use strict;
use JSON;
use Time::HiRes qw/time sleep/;
use LWP::UserAgent;
use Net::OAuth;
use Bytes::Random::Secure ();
use HTTP::Message;
use Date::Parse;
use File::Spec;
use IPC::Run;
use Digest::MD5 qw/md5_hex/;
use POSIX;
use Carp;
use Encode qw/encode/;
use Data::Dumper;
use DBI;
use IO::File;
use IO::Zlib;
use Cwd qw/realpath/;
use AnomieBOT::API::Iterator;
use AnomieBOT::API::TiedDBD;
use AnomieBOT::API::Cache;
use vars qw/$default_maxlag/;
$default_maxlag=$ENV{'AnomieBOT_maxlag'} // 5;
=pod
=head1 NAME
AnomieBOT::API - AnomieBOT API access class
=head1 SYNOPSIS
use AnomieBOT::API;
my $api = AnomieBOT::API->new('/path/to/config_file', 1);
$api->login();
$res=$api->query(list=>'allpages',apnamespace=>0,aplimit=>10);
=head1 DESCRIPTION
C
MediaWiki bot.
=head1 RETURN VALUES
Unless otherwise noted, each method returns an object with certain standard
properties:
=over
=item code
A short token indicating the result of the API call. In addition to error codes
returnable by the MediaWiki API, the following may be seen:
=over
=item success
The call succeeded.
=item httperror
An HTTP error response was returned. The object will also contain a C
property containing the full HTML returned with the error, and a C
property with the HTTP response code.
=item jsonerror
The response string could not be decoded. The object will also contain a C
property containing the response string;
=item wtferror
A "This can't happen" error occurred.
=item notloggedin
The bot user could not be logged in.
=item botexcluded
Returned by token-fetching functions if the page contains a bot exclusion
template that excludes this bot. The return object will have an extra property
C
=item shutoff
Returned by token-fetching functions if the task's shutoff page is triggered.
=item pageprotected
Returned by token-fetching functions if the page is protected and the bot lacks
the appropriate rights.
=item pagemissing
Returned by token-fetching functions if the page does not exist (when a
non-existent page doesn't make sense).
=item uploadwarnings
Returned by the upload function if warnings were returned.
=item notiterable
Returned by C<< $api->iterator() >> when the result set cannot be iterated.
=item maxlag
If maxlag is set off or the bot is trying to halt, this error may be returned
instead of the bot automatically retrying.
=back
=item error
A textual description of the error code.
=back
=head1 METHODS
Note that this class supports runtime decoratoration, so the complete set of
available methods depends on the most recent call to C<< task() >>.
=over
=item AnomieBOT::API->new( $conffile, $botnum )
Create an instance of the bot.
The config file is simply a list of "key = value"s, one per line; any line
whose first non-whitespace character is '#' is considered a comment and is
ignored.
Sections within the file are delimited with C<< [I
before the first section is considered "defaults" for any sections named "bot
I<#>".
In addition, a file may include other files by using a line
C<< @include I
the remainder of the line is the filename. By default, the file may have its
own defaults section (which is merged with the including file's) and sections;
if the "!section" option is given, the file will be considered part of the
current section and attempting to include other files or define sections will
be considered an error. If the "!ifexists" option is given, it will not be an
error if the file doesn't actually exist.
See A
not include world readability, writability, or executability.
Botnum is the instance number of this bot, which controls which of the
C<[bot #]> sections of the config file is actually used.
=cut
sub _readconf {
my ($file, $def, $CFG, $ssection) = @_;
if ( open( my $fh, '<:utf8', $file ) ) {
croak "Bad file permissions on $file" if (stat $fh)[2]&7;
my $section = $ssection // '';
while ( <$fh> ) {
next if /^\s*#/;
s/^\s+|\s+$//g;
next if $_ eq '';
if ( /^\@include\s+(.+)$/o ) {
my $newfile = $1;
if ( defined( $ssection ) ) {
croak $file.": Cannot include another file at line $.";
} else {
my %opts = ( '!section' => 0, '!ifexists' => 0 );
$opts{$1} = 1 while $newfile=~s/^(!\S+)\s+//;
croak $file.": Invalid line at line $." if $newfile eq '';
my ($volume, $dir) = File::Spec->splitpath( $file );
my $base = File::Spec->catpath( $volume, $dir, '' );
$newfile = File::Spec->rel2abs( $newfile, $base );
next if $opts{'!ifexists'} && !-e $newfile;
_readconf( $newfile, $def, $CFG, $opts{'!section'} ? $section : undef );
}
} elsif ( /^\[([^\x5b\x5d]+)\]\s*$/o ) {
if ( defined( $ssection ) ) {
croak $file.": Cannot begin a section at line $.";
} else {
$section = $1;
$CFG->{$section} //= ($section=~/^bot \d+$/) ? { %$def } : {};
}
} elsif ( /^(\S+?)\s*=\s*(.*)$/o ) {
if ( $section eq '' ) {
$def->{$1} = $2;
} else {
$CFG->{$section}{$1} = $2;
}
} else {
croak $file.": Invalid line at line $.";
}
}
close $fh;
} else {
croak "Could not open ".$file.": $!";
}
}
sub new {
my $class = shift;
my %CFG = ();
croak "USAGE: AnomieBOT::API->new(\$file, \$botnum, [\\\%opt])" unless @_==2 or @_==3;
my $botnum = $_[1];
my $opt = $_[2] // {};
my %def = ();
_readconf( $_[0], \%def, \%CFG );
carp "Bot instance number $botnum is not configured" unless exists($CFG{"bot $botnum"});
my $umask=umask;
# Check data directory
my $datadir;
if(exists($CFG{"bot $botnum"}{'datadir'})){
$datadir=$CFG{"bot $botnum"}{'datadir'};
} elsif(exists($ENV{'HOME'})){
my $d=$ENV{'HOME'};
$d.='/' unless substr($d,-1) eq '/';
$d.='.anomiebot-data/';
$datadir=$d;
} else {
die "HOME not set, please either set it or specify 'datadir' in the config file\n";
}
$datadir.='/' unless substr($datadir,-1) eq '/';
if(!-e $datadir){
umask($umask | 0007);
my $ok = mkdir($datadir);
umask($umask);
die "Data directory ".$datadir." cannot be created: $!\n" unless $ok;
}
die "Data directory ".$datadir." is not a directory\n" unless -d $datadir;
my $t=$datadir.'test'.$botnum;
if(-e $t){
unlink($t);
die "Could not remove test file $t: $!\n" if -e $t;
}
open(X, '>', $t) or die("Could not create test file $t: $!\n");
close(X);
unlink($t);
my $keep_alive = $CFG{"bot $botnum"}{'keep-alive'} // 1;
$keep_alive = undef if $keep_alive < 0;
my $cookiejar = $CFG{"bot $botnum"}{'cookiejar'} // '$DATADIR/AnomieBOT-$BOTNUM.cookies';
$cookiejar=~s/\$BOTNUM/$botnum/g;
$cookiejar=~s/\$DATADIR/$datadir/g;
umask($umask | 0007);
my $ua=LWP::UserAgent->new(
agent=>"AnomieBOT/1.0 (no task; see User:".$CFG{"bot $botnum"}{'lguser'}.")",
from=>$CFG{"bot $botnum"}{'email'} // undef,
cookie_jar=>{ file=>$cookiejar, autosave=>1 },
env_proxy=>1,
keep_alive=>$keep_alive,
);
$ua->cookie_jar->save();
umask($umask);
my $commandfile = $CFG{"bot $botnum"}{'commandfile'} // '$DATADIR/AnomieBOT-$BOTNUM.cmd';
$commandfile=~s/\$BOTNUM/$botnum/g;
$commandfile=~s/\$DATADIR/$datadir/g;
my $logfile = $CFG{"bot $botnum"}{'logfile'} // '';
$logfile=~s/\$BOTNUM/$botnum/g;
$logfile=~s/\$DATADIR/$datadir/g;
my $errfile = $CFG{"bot $botnum"}{'errfile'} // '';
$errfile=~s/\$BOTNUM/$botnum/g;
$errfile=~s/\$DATADIR/$datadir/g;
die "Cannot use other users' home directory in commandfile\n" if $commandfile=~m!^~[^/]!;
die "Cannot use other users' home directory in logfile\n" if $logfile=~m!^~[^/]!;
die "Cannot use other users' home directory in errfile\n" if $errfile=~m!^~[^/]!;
if(exists($ENV{'HOME'})){
my $home = $ENV{'HOME'};
$commandfile=~s!^~/!$home/!;
$logfile=~s!^~/!$home/!;
$errfile=~s!^~/!$home/!;
} else {
die "HOME is not set, cannot use ~/ in commandfile\n" if $commandfile=~m!^~/!;
die "HOME is not set, cannot use ~/ in logfile\n" if $logfile=~m!^~/!;
die "HOME is not set, cannot use ~/ in errfile\n" if $errfile=~m!^~/!;
}
my $memlimit = $CFG{"bot $botnum"}{'memlimit'} // '256Mi';
my $cpulimit = $CFG{"bot $botnum"}{'cpulimit'} // '250m';
my $rand = Bytes::Random::Secure->new( NonBlocking => 1 );
my $self = {
botnum => $botnum,
datadir => $datadir,
ua => $ua,
rand => $rand,
j => JSON->new->utf8(0),
task => 'no task',
store => undef,
wikibase => $CFG{"bot $botnum"}{'basepath'} // 'https://en.wikipedia.org/w/',
lguser => $CFG{"bot $botnum"}{'lguser'} // '',
lgpass => $CFG{"bot $botnum"}{'lgpass'} // '',
oauth_consumer_token => $CFG{"bot $botnum"}{'oauth_consumer_token'} // '',
oauth_consumer_secret => $CFG{"bot $botnum"}{'oauth_consumer_secret'} // '',
oauth_access_token => $CFG{"bot $botnum"}{'oauth_access_token'} // '',
oauth_access_secret => $CFG{"bot $botnum"}{'oauth_access_secret'} // '',
email => $CFG{"bot $botnum"}{'email'} // undef,
operator => $CFG{"bot $botnum"}{'operator'} // undef,
read_throttle => 0,
edit_throttle => 10,
assert => $CFG{"bot $botnum"}{'assert'} // '',
nassert => $CFG{"bot $botnum"}{'nassert'} // '',
assert_edit => $CFG{"bot $botnum"}{'assert_edit'} // 'bot',
nassert_edit => $CFG{"bot $botnum"}{'nassert_edit'} // '',
use_encodings => !($CFG{"bot $botnum"}{'disable-transfer-encodings'} // 0),
lastread => 0,
lastedit => time(),
debug => $CFG{"bot $botnum"}{'DEBUG'} // 0,
automaxlag => 1,
noedit => undef,
nopause => 0,
onpause => undef,
editlimit => undef,
decorators => [],
queryprops => undef,
queryprefix => undef,
queryparams => undef,
paramlimits => {},
edit_watchlist => 'nochange',
memlimit => $memlimit,
cpulimit => $cpulimit,
commandfile => $commandfile,
logfile => $logfile,
errfile => $errfile,
halting => 0,
replica_dsn => $CFG{"bot $botnum"}{'replica_dsn'} // '',
replica_user => $CFG{"bot $botnum"}{'replica_user'} // '',
replica_pass => $CFG{"bot $botnum"}{'replica_pass'} // '',
};
$self->{'replica_dsn'}=~s/\$BOTNUM/$botnum/g;
$self->{'replica_dsn'}=~s/\$DATADIR/$datadir/g;
if(exists($ENV{'HOME'})){
my $home = $ENV{'HOME'};
$self->{'replica_dsn'}=~s/\$HOME/$home/g;
} else {
die "HOME is not set, cannot use \$HOME in replica_dsn\n" if $self->{'replica_dsn'}=~/\$HOME/;
}
$self->{'use_oauth'} = $self->{'oauth_consumer_token'} ne '' &&
$self->{'oauth_consumer_secret'} ne '' &&
$self->{'oauth_access_token'} ne '' &&
$self->{'oauth_access_secret'} ne '';
# Create cache
$self->{'cache'} = AnomieBOT::API::Cache->create(
$CFG{"bot $botnum"}{'cache_handler'}//'Memcached',
$CFG{"bot $botnum"}{'cache_options'}//'servers=127.0.0.1:112211;namespace=ChangeMe:',
);
# Open persistant storage
$CFG{"bot $botnum"}{'store_dsn'}='dbi:SQLite:dbname=$DATADIR/AnomieBOT-$BOTNUM.db' unless exists($CFG{"bot $botnum"}{'store_dsn'});
$CFG{"bot $botnum"}{'store_dsn'}=~s/\$BOTNUM/$botnum/;
$CFG{"bot $botnum"}{'store_dsn'}=~s/\$DATADIR/$datadir/;
if(exists($ENV{'HOME'})){
my $home = $ENV{'HOME'};
$CFG{"bot $botnum"}{'store_dsn'}=~s/\$HOME/$home/g;
} else {
die "HOME is not set, cannot use \$HOME in store_dsn for bot $botnum\n" if $CFG{"bot $botnum"}{'store_dsn'}=~/\$HOME/;
}
$CFG{"bot $botnum"}{'store_user'}='' unless exists($CFG{"bot $botnum"}{'store_user'});
$CFG{"bot $botnum"}{'store_pass'}='' unless exists($CFG{"bot $botnum"}{'store_pass'});
if($opt->{'db'} // 1){
umask($umask | 0007);
$self->{'store'}=DBI->connect($CFG{"bot $botnum"}{'store_dsn'}, $CFG{"bot $botnum"}{'store_user'}, $CFG{"bot $botnum"}{'store_pass'}, { AutoCommit=>1, RaiseError=>1, mysql_auto_reconnect=>1 });
umask($umask);
die "Could not open database\n" unless $self->{'store'};
$self->{'storetask'}=undef;
$self->{'storehash'}=undef;
}
# Copy extra config sections for access by tasks
$self->{'CFG'}={};
while(my ($k,$v)=each %CFG){
next if $k=~/^bot \d+$/;
$self->{'CFG'}{$k}=$v;
}
bless $self, $class;
return $self;
}
sub loadqueryprops {
my $self=shift;
return undef if defined($self->{'queryprops'});
my $res=$self->_query(action=>'paraminfo',modules=>'query',__noassert=>1);
return $res unless $res->{'code'} eq 'success';
my @prop=();
my @all=();
for my $p (@{$res->{'paraminfo'}{'modules'}[0]{'parameters'}}) {
@prop=@{$p->{'type'}} if $p->{'name'} eq 'prop';
@all=(@all,@{$p->{'type'}}) if($p->{'name'} eq 'prop' || $p->{'name'} eq 'list' || $p->{'name'} eq 'generator' || $p->{'name'} eq 'meta');
}
@all=keys %{{ map { $_ => 1 } @all }};
my %props=();
my %prefix=();
my %params=();
while(@all){
$res=$self->_query(action=>'paraminfo',modules=>join('|',map("query+$_",splice(@all,0,50))),__noassert=>1);
return $res unless $res->{'code'} eq 'success';
for my $p (@{$res->{'paraminfo'}{'modules'}}) {
$props{$p->{'prefix'}}=$p->{'name'} if grep $_ eq $p->{'name'}, @prop;
$prefix{$p->{'name'}}=$p->{'prefix'};
$params{$p->{'name'}}={};
for my $pp (@{$p->{'parameters'}}) {
$params{$p->{'name'}}{$p->{'prefix'}.$pp->{'name'}} = $p->{'prefix'}.$pp->{'name'};
}
}
}
$self->{'queryprops'}=\%props;
$self->{'queryprefix'}=\%prefix;
$self->{'queryparams'}=\%params;
return undef;
}
=pod
=item $api->copy( %config )
Get a new AnomieBOT::API with the specified options changed.
=cut
sub copy {
my ($self, %config) = @_;
my $new = {
%$self,
storetask => undef,
storehash => undef,
%config
};
bless $new, ref $self;
return $new;
}
=pod
=item $api->DEBUG
=item $api->DEBUG( $bitmask )
Get/set the debug bitmask. When debugging is enabled, most methods will output
useful text to standard error.
Returns the old value of the bitmask.
=cut
sub DEBUG {
my $self=shift;
my $old=$self->{'debug'};
if(@_){
croak "Invalid DEBUG bitmask: $_[0]" unless $_[0]=~/^[+-]?\d+$/;
$self->{'debug'}=$_[0];
}
return $old;
}
=pod
=item $api->reopen_logs()
Reopen STDOUT and STDERR to the configured log files.
=cut
sub reopen_logs {
my $self=shift;
if($self->{'logfile'} ne ''){
open(STDOUT, '>>', $self->{'logfile'}) or die "Cannot redirect STDOUT: $!\n";
}
if($self->{'errfile'} ne ''){
my $olderr;
open($olderr, ">&STDERR") or die "Cannot dup STDERR: $!\n";
if(!open(STDERR, '>>', $self->{'errfile'})) {
# Output the error message to the old STDERR
print $olderr "Cannot redirect STDERR: $!\n";
exit 1;
}
close($olderr);
}
my $fh = select;
binmode STDOUT, ':utf8';
select STDOUT; $| = 1;
binmode STDERR, ':utf8';
select STDERR; $| = 1;
select $fh;
}
=pod
=item AnomieBOT::API::copy_truncate_file( $from, $to, $fh )
Copy file C<$from> to C<$to> (gzipping on the way), then truncate via C<$fh>.
=cut
sub copy_truncate_file {
my ( $from, $to, $fh ) = @_;
flush $fh;
unlink $to if -e $to;
my $ffh = IO::File->new( $from, 'r' );
die "Cannot rotate $from: Cannot read $from: $!\n" unless defined( $ffh );
my $tfh = IO::Zlib->new( $to, 'wb9' );
die "Cannot rotate $from: Cannot open $to: $!\n" unless defined( $tfh );
my ( $l, $buf );
while ( $l = sysread( $ffh, $buf, 8192 ) ) {
my $o = 0;
while ( $o < $l ) {
my $l2 = syswrite( $tfh, $buf, $l - $o, $o );
die "Cannot rotate $from: Write $to failed: $!\n" unless defined( $l2 );
$o += $l2;
}
}
die "Cannot rotate $from: Read $from failed: $!\n" unless defined( $l );
$tfh->close;
$ffh->close;
truncate $fh, 0 or die "Cannot truncate $from: $!\n";
seek $fh, 0, 0 or die "Cannot rewind $from: $!\n";
}
=pod
=item $api->rotate_logs()
Rotate the log files.
=cut
sub rotate_logs {
my $self=shift;
copy_truncate_file( $self->{'logfile'}, $self->{'logfile'} . '.1.gz', \*STDOUT ) if $self->{'logfile'} ne '';
copy_truncate_file( $self->{'errfile'}, $self->{'errfile'} . '.1.gz', \*STDERR ) if $self->{'errfile'} ne '';
}
=pod
=item $api->warn( $message )
=item AnomieBOT::API->warn( $message )
=item $api->log( $message )
=item AnomieBOT::API->log( $message )
=item $api->debug( $bitmask, $message )
=item AnomieBOT::API->debug( $debuglevel, $bitmask, $message )
Output messages.
=cut
sub warn {
my $self=shift;
$self={ task=>'static', botnum=>0 } unless ref($self);
my $msg=shift;
if(-t STDERR){
my $nl='';
$nl="\n" if $msg=~s/\n$//;
carp "\e[31m".POSIX::strftime('[%F %T] ', localtime).$self->{'task'}.' ('.$self->{'botnum'}."): $msg\e[0m$nl";
} else {
carp POSIX::strftime('W [%F %T] ', localtime).$self->{'task'}.' ('.$self->{'botnum'}.'): '.$msg;
}
}
sub log {
my $self=shift;
$self={ task=>'static', botnum=>0 } unless ref($self);
my $msg=shift;
print POSIX::strftime('[%F %T] ', localtime).$self->{'task'}.' ('.$self->{'botnum'}.'): '.$msg."\n";
}
sub debug {
my $self=shift;
$self={ task=>'static', botnum=>0, debug=>shift } unless ref($self);
my $mask=shift;
my $msg=shift;
if($self->{'debug'} & $mask){
if(-t STDERR){
my $nl='';
$nl="\n" if $msg=~s/\n$//;
carp "\e[33m".POSIX::strftime('[%F %T] ', localtime).$self->{'task'}.' ('.$self->{'botnum'}."): $msg\e[0m$nl";
} else {
carp POSIX::strftime('D [%F %T] ', localtime).$self->{'task'}.' ('.$self->{'botnum'}.'): '.$msg;
}
}
}
=pod
=item $api->check_commands()
=item $api->check_commands( $file )
Check if there are any pending commands for this instance. Returns the command,
if any, unless the command was "KILL".
An optional filename may be passed to override the normal command file.
=item $api->read_command()
=item $api->read_command( $file )
=item $api->read_command( $file, $nodelete )
Read any pending command; to be called on startup. Returns the command, if
any. The pending command is cleared, unless it matches the C<$nodelete>
regexp.
An optional filename may be passed to override the normal command file.
=item $api->send_command( $file, $command )
Sends a command to the specified file, overwriting any pending command (if
any). Returns true on success, undef on failure.
=item $api->onpause()
=item $api->onpause( \&sub )
Get/set a subroutine to be called when the "pause" command is received. The
subroutine will be passed a single argument, 1 when the pause command is
received and 0 when it is cleared.
Returns the old subroutine, if any.
=cut
sub onpause {
my $self = shift;
my $ret = $self->{'onpause'};
if ( @_ ) {
$self->{'onpause'} = shift;
}
return $ret;
}
sub check_commands {
my $self = shift;
my $file = shift // $self->{'commandfile'};
my $cmd = $self->read_command( $file, qr/^pause$|^restart-hash/ );
return undef unless defined( $cmd );
local $self->{'task'} = '[command processor]';
if($cmd =~ '^restart-hash ([0-9a-f]{40})$'){
my $hash = $1;
my $curhash = '';
my $t = IPC::Run::timeout( 5 );
$t->exception( 'git rev-parse timed out' );
eval {
IPC::Run::run( [qw(git rev-parse HEAD)], '>', \$curhash, $t ) or die "Git rev-parse failed with code $?\n";
};
if ( $@ ) {
$self->warn( $@ );
return undef;
}
chomp $curhash;
if ( $curhash eq $hash ) {
$self->warn("Restarting to update to git hash $hash!");
$self->{'halting'}=$cmd;
$self->read_command( $file, qr/^(?!\Q$cmd\E\s*$)/ );
return $cmd;
}
return undef;
} elsif($cmd eq 'restart'){
$self->warn("Restart signal received!");
$self->{'halting'}=$cmd;
} elsif($cmd eq 'term'){
$self->warn("Halt signal received!");
$self->{'halting'}=$cmd;
} elsif($cmd eq 'kill'){
$self->warn("Kill signal received!");
exit(0);
} elsif($cmd eq 'pause'){
if($self->{'nopause'}){
#$self->warn("Ignoring pause signal");
#$self->send_command( $file, undef );
} else {
$self->warn("Pause signal received! Pausing until $file is changed.");
$self->{'onpause'}(1) if $self->{'onpause'};
while($cmd eq 'pause'){
sleep(1);
$cmd = $self->read_command( $file, qr/^/ ) // '';
}
$self->warn("Pause signal cleared!");
$self->{'onpause'}(0) if $self->{'onpause'};
return $self->check_commands( $file );
}
} elsif($cmd eq 'rotatelogs'){
$self->log("Rotating log files");
$self->warn("Rotating log files");
$self->rotate_logs();
$self->log("Log files rotated");
$self->warn("Log files rotated");
} elsif($cmd eq 'reopen'){
$self->log("Reopening log files");
$self->warn("Reopening log files");
$self->reopen_logs();
$self->log("Log files reopened");
$self->warn("Log files reopened");
} elsif($cmd eq 'ping'){
$self->log("Pong!");
$self->warn("Pong!");
} elsif($cmd =~ /^debug\s+([+-]?\d+)$/){
my $old = $self->DEBUG($1);
$self->warn("Set DEBUG = $1, was $old\n");
} elsif($cmd =~ /^debug(?:\s.*)?$/){
$self->warn("Invalid 'debug' command");
} else {
$self->warn("Received unknown command '$cmd'\n");
}
return $cmd;
}
sub read_command {
my $self = shift;
my $file = shift // $self->{'commandfile'};
my $nodelete = shift // qr/^(?!)/;
my $cmd = undef;
if ( $file =~ /^cache:(.*)/ ) {
my $key = $1;
$cmd = $self->cache->get( $key );
$self->cache->delete( $key ) if defined( $cmd ) && $cmd !~ /$nodelete/;
} else {
my $fh;
if(open($fh, "<", $file)) {
$cmd = <$fh>;
close($fh);
$cmd=~s/^\s+|\s+$//g;
unlink( $file ) if $cmd !~ /$nodelete/;
}
}
return $cmd;
}
sub send_command {
my $self = shift;
my $file = shift;
my $cmd = shift;
if ( $file =~ /^cache:(.*)/ ) {
if ( defined( $cmd ) ) {
$self->cache->set( $1, $cmd );
} else {
$self->cache->delete( $1 );
}
} else {
if ( defined( $cmd ) ) {
my $fh;
return undef unless open($fh, ">", $file);
print $fh $cmd;
close($fh);
} else {
unlink( $file );
}
}
return 1;
}
=pod
=item $api->halting
Process commands, then return a true value if the bot is supposed to halt.
=item $api->halting( $value )
Set the return value for future calls to halting().
=cut
sub halting {
my $self = shift;
if(@_){
$self->{'halting'} = shift;
} else {
$self->check_commands();
}
return $self->{'halting'};
}
=pod
=item $api->automaxlag
=item $api->automaxlag( $bool )
Get/set the auto-continue maxlag flag. Note that task() resets this.
Returns the old value of the flag.
=cut
sub automaxlag {
my $self=shift;
my $old=$self->{'automaxlag'};
$self->{'automaxlag'}=$_[0]?1:0 if(@_);
return ($old && !$self->halting);
}
=pod
=item $api->edit_watchlist
=item $api->edit_watchlist( $value )
Get/set the editing C
currently C
C
Returns the old value.
=cut
sub edit_watchlist {
my $self=shift;
my $old=$self->{'edit_watchlist'};
$self->{'edit_watchlist'}=$_[0] if(@_);
return $old;
}
=pod
=item $api->user
Returns the bot user name.
=item $api->operator
Returns the bot operator's user name.
=cut
sub user {
my $self=shift;
return $self->{'lguser'};
}
sub operator {
my $self=shift;
return $self->{'operator'};
}
=pod
=item $api->task
=item $api->task( $name )
=item $api->task( $name, $read_rate, $write_rate, @decoraters )
Get/set the current task.
When called with no arguments, simply returns the current task name.
With arguments, it sets the task name, read/write rate limits, and the current
list of decorators. If omitted, it defaults to 0 seconds per read, 10 seconds
per write, and no decorators.
=item $api->read_throttle
=item $api->read_throttle( $seconds )
Get/set the current read throttle time. If a read is attempted less than
$seconds seconds after a previous read or edit, the bot will sleep for the
remaining time.
Returns the old throttle.
=item $api->edit_throttle
=item $api->edit_throttle( $seconds )
Get/set the current edit throttle time. If an edit is attempted less than
$seconds seconds after a previous read or edit, the bot will sleep for the
remaining time.
Returns the old throttle.
=item $api->decorators
=item $api->decorators( @decorators )
Get/set the current list of decorators. Note that functions are first searched
for in the current object (thus a decorator cannot override native functions),
then in each decorator I
decorators, pass undef as the only argument.
Returns the old list of decorators.
=cut
sub task {
my $self=shift;
my $old=$self->{'task'};
if(@_){
$self->{'task'}=shift;
$self->{'ua'}->agent("AnomieBOT/1.0 (".encode('UTF-8',$self->{'task'})."; see User:".$self->{'lguser'}.")");
$self->debug(1, 'Beginning task');
$self->read_throttle(shift // 0);
$self->edit_throttle(shift // 10);
$self->decorators(@_ ? @_ : undef);
$self->automaxlag(1);
}
return $old;
}
sub read_throttle {
my $self=shift;
my $old=$self->{'read_throttle'};
if(@_){
my $n=shift;
if($n!~/^(?:\d*\.)?\d+$/ || $n<0){
carp "Time value for read_throttle must be a non-negative floating point number.";
} else {
$self->{'read_throttle'}=0.0+$n;
$self->debug(1, "Read throttle set to $n seconds");
}
}
return $old;
}
sub edit_throttle {
my $self=shift;
my $old=$self->{'edit_throttle'};
if(@_){
my $n=shift;
if($n!~/^(?:\d*\.)?\d+$/ || $n<0){
carp "Time value for edit_throttle must be a non-negative floating point number.";
} else {
$self->{'edit_throttle'}=0.0+$n;
$self->debug(1, "Edit throttle set to $n seconds");
}
}
return $old;
}
sub decorators {
my $self=shift;
my $old=$self->{'decorators'};
if(@_){
$self->{'decorators'}=[defined($_[0])?@_:()];
$self->debug(1, "Decorators: ".join(', ', @{$self->{'decorators'}}));
load($_) foreach (@{$self->{'decorators'}});
}
return @$old;
}
sub _throttle {
my $self=shift;
my $which=shift;
my $t;
if($which eq 'read'){
$t=$self->{'read_throttle'}-(time()-$self->{'lastread'});
sleep($t) if $t>0;
$self->{'lastread'}=time();
} elsif($which eq 'edit'){
$t=$self->{'edit_throttle'}-(time()-$self->{'lastedit'});
sleep($t) if $t>0;
$self->{'lastedit'}=time();
$self->{'lastread'}=$self->{'lastedit'};
}
}
=pod
=item $api->is_trial
Returns a true value if a trial is running. This can be used to disable an
unapproved code addition in the live code while running it for trial.
=cut
sub is_trial {
my $self=shift;
return defined($self->{'editlimit'});
}
=pod
=item $api->CFG
Access the configuration settings for the current task. The most common use
will be along the lines of C<< $api->CFG->{$property} >>.
=cut
sub CFG {
my $self=shift;
$self->{'CFG'}{$self->{'task'}}={} unless exists($self->{'CFG'}{$self->{'task'}});
return $self->{'CFG'}{$self->{'task'}};
}
=pod
=item $api->store
Returns a hashref tied to persistant storage corresponding to the current task,
or undef if no task is set.
Since this is tied to persistant storage, only scalars (no scalar refs),
hashrefs, and arrayrefs may be stored in the array. Anything else will cause a
fatal error.
=cut
sub store {
my ($self) = @_;
return undef unless defined($self->{'task'});
if(!defined($self->{'storetask'}) || $self->{'task'} ne $self->{'storetask'}){
untie %{$self->{'storehash'}};
$self->{'storetask'}=$self->{'task'};
tie %{$self->{'storehash'}}, 'AnomieBOT::API::TiedDBD', $self->{'store'}, 'AnomieBOT_Store', 'k', 'v', task => $self->{'storetask'};
}
return $self->{'storehash'};
}
=pod
=item $api->cache
Returns an A
=cut
sub cache {
my ($self) = @_;
return $self->{'cache'};
}
=pod
=item $api->connectToReplica( $wiki )
=item $api->connectToReplica( $wiki, $svc )
Calls C<< DBI->connect >> and returns the database handle.
If C
C<$svc> replaces a C<$SVC> token in C
=cut
sub connectToReplica {
my $self = shift;
my $wiki = shift;
my $svc = shift || 'web';
my $dsn = $self->{'replica_dsn'};
carp "'replica_dsn' is not set\n" if $dsn eq '';
$dsn=~s/\$WIKI/$wiki/g;
$dsn=~s/\$SVC/$svc/g;
my $dbh = DBI->connect($dsn, $self->{'replica_user'}, $self->{'replica_pass'}, { AutoCommit=>1, RaiseError=>1, mysql_auto_reconnect=>1 });
return wantarray ? ($dbh) : $dbh;
}
=pod
=item $api->drop_connections
Drops any connections in the Keep-Alive state. Call this if you will not be
making API calls for the next 300 seconds.
=cut
sub drop_connections {
my $self=shift;
$self->{'ua'}->conn_cache->drop();
}
=pod
=item $api->rawpage( $title )
=item $api->rawpage( $title, $oldid )
Get the raw wikitext of a page, specified by title and (optionally) revision
id. The return object has the following additional properties:
=over
=item content
Content of the page
=back
As with C
=cut
sub rawpage {
my @args=@_;
my $self = shift @args;
my $title = shift @args;
my %q = @args ? ( 'revids' => $args[0] ) : ( 'titles' => $title, 'rvlimit' => 1 );
my $res = $self->query(
prop => 'revisions',
rvprop => 'content',
rvslots => 'main',
%q,
);
if ( $res->{'code'} eq 'success' ) {
return {
code => 'success',
error => 'Success',
content => (values %{$res->{'query'}{'pages'}})[0]{'revisions'}[0]{'slots'}{'main'}{'*'} // '',
};
} else {
return $res;
}
}
sub _ISO2wptime {
my $t=shift;
return $1.$2.$3.$4.$5.$6
if $t=~/^(\d{4})-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)Z$/;
}
sub _query {
my ($self, %param) = @_;
my $nolog=(exists($param{'__nolog'}) && $param{'__nolog'});
my $errok=(exists($param{'__errok'}) && $param{'__errok'});
my $noassert=(exists($param{'__noassert'}) && $param{'__noassert'});
my $T272319_retries = $param{'__T272319_retries'} // 0;
delete $param{'__nolog'};
delete $param{'__errok'};
delete $param{'__noassert'};
delete $param{'__T272319_retries'};
my $raw=exists($param{'format'});
$param{'format'}='json' unless $raw;
$param{'maxlag'}=$default_maxlag unless exists($param{'maxlag'});
$param{'rawcontinue'}=1 if($param{'action'} eq 'query' && !exists($param{'continue'}));
$param{'assert'}=$self->{'assert'} if(!$noassert && !exists($param{'assert'}) && $self->{'assert'} ne '');
$param{'nassert'}=$self->{'nassert'} if(!$noassert && !exists($param{'nassert'}) && $self->{'nassert'} ne '');
# Convert for logging before the utf8::encode().
my $q;
if($nolog){
$q='[unlogged]';
} else {
$q=Dumper(\%param);
$q=~s/\n\s*/ /g;
}
my %h=(
'Content_Type' => 'form-data',
#'X-Wikimedia-Debug' => 'backend=mwdebug1001.eqiad.wmnet; log',
);
while(my ($k,$v)=each %param){
utf8::encode($param{$k}) if(!ref($v));
}
if($self->{'use_encodings'}) {
my $can_accept=HTTP::Message::decodable;
$h{'Accept-Encoding'}=$can_accept if $can_accept;
}
my $url = $self->{'wikibase'}.'api.php';
if ( $self->{'use_oauth'} ) {
my $nonce = sprintf( '%x.%s.%08x', $$, $self->{'rand'}->bytes_base64( 15 ), (time() * 1e6) & 0xffffffff );
$nonce =~ y!+/\n!-_!d;
# Note: POST data isn't included here because AnomieBOT always uses
# multipart/form-data
my $request = Net::OAuth->request( 'protected resource' )->new(
request_method => 'POST',
request_url => $url,
consumer_key => $self->{'oauth_consumer_token'},
consumer_secret => $self->{'oauth_consumer_secret'},
token => $self->{'oauth_access_token'},
token_secret => $self->{'oauth_access_secret'},
signature_method => 'HMAC-SHA1',
timestamp => int(time()),
nonce => $nonce,
);
$request->sign;
$h{'Authorization'} = $request->to_authorization_header;
}
my $res=$self->{'ua'}->post($url, \%param, %h);
if($res->code!=200){
$self->warn("Query failed: ".$res->status_line);
#$self->warn("Failed query was $q");
return {
code => 'httperror',
httpcode => $res->code,
error => $res->status_line,
page => $res->decoded_content
};
}
if($raw){
$self->debug(1, "Query $q");
return {
code => 'success',
error => 'Success',
content => $res->decoded_content
};
}
my $ret;
eval { $ret=$self->{'j'}->utf8->decode($res->decoded_content // ''); };
if($@){
$self->warn("JSON decoding failed: $@");
#$self->warn("Failed query was $q");
return {
code => 'jsonerror',
error => $@,
page => $res->decoded_content
};
}
$ret={ '*' => $ret } if ref($ret) ne 'HASH';
if($ret->{'error'}){
if($ret->{'error'}{'code'} eq 'maxlag'){
$ret=$self->_handle_maxlag($res, $ret->{'error'}{'info'});
return $ret if defined($ret);
goto \&_query;
} elsif($ret->{'error'}{'code'} =~ /^assert.*failed/){
# Assertion failed. Maybe we're not logged in?
my $ret2=$self->_query(action=>'query', meta=>'userinfo', maxlag => 600, __noassert => 1);
return {
code => $ret->{'error'}{'code'},
error => $ret->{'error'}{'info'}
} if($ret2->{'code'} eq 'success' && $ret2->{'query'}{'userinfo'}{'name'} eq $self->{'lguser'});
$ret2 = $self->login(1);
return $ret2 unless $ret2->{'code'} eq 'success';
goto \&_query;
} elsif($ret->{'error'}{'code'} eq 'mwoauth-invalid-authorization' && $ret->{'error'}{'info'} =~ /Nonce already used:/ && $T272319_retries++ < 10){
# Wikimedia has been having major problems with this lately, see T272319
$self->debug(1, "Retrying (#$T272319_retries) to work around T272319");
push @_, '__T272319_retries', $T272319_retries;
sleep(0.01);
goto \&_query;
} else {
unless(ref($errok) eq 'ARRAY' && grep $_ eq $ret->{'error'}{'code'}, @$errok){
$self->debug(1, "Query $q");
$self->warn("MediaWiki error: ".$ret->{'error'}{'info'});
#$self->warn("Failed query was $q");
}
my %ret2 = %{$ret->{'error'}};
$ret2{'servedby'} = $ret->{'servedby'}//'unknown';
$ret2{'error'} = $ret->{'error'}{'info'};
delete($ret2{'info'});
return \%ret2;
}
}
if($ret->{'warnings'}){
$self->debug(1, "Query $q");
while ( my ($module, $warning) = each (%{$ret->{'warnings'}}) ) {
$self->warn("MediaWiki warning: $module: " . $warning->{'*'});
}
}
$self->debug(1, "Query $q");
$ret->{'code'}='success';
$ret->{'error'}='Success';
return $ret;
}
=pod
=item $api->query( key => value, ... )
=item $api->query( \@continues, key => value, ... )
Perform a general MediaWiki API query.
As you should be aware, if an L
return an excessive amount of data, only the first bit will be returned and
various continuation parameters will be returned to get the next bit in a
future call. The array reference C<\@continues> specifies how to handle that:
those multiple calls will be made automatically for all modules I
Note that you will get errors if your query uses a generator and you specify
any non-generator modules without also specifying the generator module. To
specify the generator module, prefix the module name with "g|". If for some
reason you need to specify the continuation parameter explicitly, join it to
the module name with a "|" (e.g. "revisions|rvcontinue"); note this is not
recommended.
If C<\@continues> is not provided, the default value consists of the
generator or list modules specified in the query, plus "revisions|rvcontinue"
(we don't want to download all several-thousand revisions automatically when
prop=revisions is in enum mode).
The keys and values are those needed for the API call, with the following
exceptions:
=over
=item action
If omitted, "query" will be assumed. Do not use "login", "edit", "move", or
others that have a method provided.
=item format
If not specified, the json-format response will be decoded as a Perl object,
the standard properties will be added, and the object will be returned. This is
most likely what you want.
If specified (even as "json"), the raw response text will be returned in the
C
detected.
=item maxlag
If unspecified, the default value "5" will be used. Maxlag errors are (usually)
automatically retried.
=item __nolog
If specified and true, the query will not be output to the bot log (when
debugging is active). Use this if the query contains passwords or other
sensitive information.
=item __errok
Specify an array of MediaWiki error codes that will not be logged. Use this if
you expect the query might fail and don't want to clutter the log. For example,
you might set C<['editconflict']> when calling L
you were expecting edit conflicts.
=back
The return value is normally the API response object, but see above for
details.
=cut
sub query {
my $self = shift;
my (@continues, %param);
if(ref($_[0]) eq 'ARRAY'){
@continues = @{shift()};
%param = @_;
} else {
%param = @_;
@continues = ('revisions|rvcontinue');
push @continues, $param{'list'} if exists($param{'list'});
push @continues, 'g|'.$param{'generator'} if exists($param{'generator'});
}
$param{'action'}='query' unless exists($param{'action'});
if(grep $param{'action'} eq $_, qw/edit move login logout upload/){
my $e="Use AnomieBOT::API->".$param{'action'}." instead of passing action=".$param{'action'}." to AnomieBOT::API->query";
carp $e;
return {
code => 'params',
error => $e
};
}
# Split the query prop/list/meta params into several sets
my $qpres=$self->loadqueryprops;
return $qpres if defined($qpres);
my %propparams = ();
my %listparams = ();
my %map = ();
if ($param{'action'} eq 'query') {
%map = (
prop => \%propparams,
list => \%listparams,
meta => \%listparams,
);
while (my ($prop, $list) = each %map) {
if (($param{$prop}//) ne ) {
$list->{$prop} = $param{$prop};
delete($param{$prop});
for my $p (split /\|/, $list->{$prop}) {
my $pp = $self->{'queryparams'}{$p};
while (my ($k,$v) = each(%param)) {
next unless exists($pp->{$k});
$list->{$k} = $v;
delete($param{$k});
}
}
}
}
}
# Is a query, so loop over specified continuations. To do it right, we need
# nested loops: the inner loop runs over all non-generator continuations to
# completion, and the outer loop runs over the generator continuation.
my $ret={};
my %c2=();
my %retc=();
my %savepropparams = %propparams;
do {
# First, do non-generators
my %gc=();
my %c=();
do {
# Perform query: passed params, the "prop=??" value, and continues
$self->_throttle('read');
my $res=$self->_query(%param, %propparams, %listparams, %c, %c2);
return $res if($res->{'code'} ne 'success');
# Process query-continue
%c=();
my %p=();
if(exists($res->{'query-continue'})){
my $qpres=$self->loadqueryprops;
return $qpres if defined($qpres);
my %prefixes=%{$self->{'queryprefix'}};
while(my ($p,$n)=each(%{$res->{'query-continue'}})){
my $prefix=$prefixes{$p}//'**';
while(my ($k,$v)=each(%$n)){
my $g=0;
if(substr($k,0,length($prefix)) eq $prefix){
# Normal parameter
$g=grep(($p eq $_ || "$p|$k" eq $_), @continues);
} elsif(substr($k,0,length($prefix)+1) eq "g$prefix"){
# Generator parameter; at this point, don't continue it.
$g=1;
} else {
# WTF?
$self->warn("Got continuation parameter $k for module $p");
}
if($g){
# Return this one to the caller
$gc{$p}={} if(!exists($gc{$p}));
$gc{$p}{$k}=$v if(!exists($gc{$p}{$k}));
if($gc{$p}{$k} ne $v){
my $e="$p.$k of $v doesn't match previous call's value of ".$gc{$p}{$k}."!";
CORE::warn("\e[31;01m$e\e[0m");
return {
code => 'wtferror',
error => $e,
};
}
} else {
# Continue on this one
$c{$k}=$v;
$p{$p}=1;
}
}
}
delete $res->{'query-continue'};
}
# Update prop/meta/list", only keep the ones we're continuing on
while (my ($prop, $list) = each %map) {
next if ($list->{$prop}//) eq ;
my @keep = ();
for my $pn (split /\|/, $list->{$prop}) {
if (exists($p{$pn})) {
push @keep, $pn;
} else {
for my $k (keys %{$self->{'queryparams'}{$pn}}) {
delete($list->{$k});
}
}
}
if ( @keep ) {
$list->{$prop} = join('|', @keep);
} else {
delete($list->{$prop});
}
}
# Merge queries
_mergequeries($ret, $res);
} while(%c);
# Now, continue any generators that need continuing
%c2=();
if(%gc){
my %prefixes=%{$self->{'queryprefix'}};
while(my ($p,$n)=each(%gc)){
my $prefix=$prefixes{$p}//'**';
while(my ($k,$v)=each(%$n)){
my $g=0;
if(substr($k,0,length($prefix)) eq $prefix){
# Normal parameter
$g=grep(($p eq $_ || "$p|$k" eq $_), @continues);
} elsif(substr($k,0,length($prefix)+1) eq "g$prefix"){
# Generator parameter
$g=grep(("g|$p" eq $_ || "g|$p|$k" eq $_), @continues);
} else {
# WTF?
$self->warn("Got continuation parameter $k for module $p");
}
if($g){
# Return this one to the caller
$retc{$p}={} if(!exists($retc{$p}));
$retc{$p}{$k}=$v if(!exists($retc{$p}{$k}));
if($retc{$p}{$k} ne $v){
my $e="$p.$k of $v doesn't match previous call's value of ".$retc{$p}{$k}."!";
CORE::warn("\e[31;01m$e\e[0m");
return {
code => 'wtferror',
error => $e,
};
}
} else {
# Continue on this one
$c2{$k}=$v;
}
}
}
# Reset the prop parameters for the generator continuation
%propparams = %savepropparams;
}
} while(%c2);
# Add the returnable continue parameters, if any
$ret->{'query-continue'}=\%retc if %retc;
return $ret;
}
sub _mergequeries {
my ($to,$from) = @_;
while(my ($k,$v)=each(%$from)){
my $r=ref($v);
next if($r eq 'ARRAY' && @$v == 0);
if(!exists($to->{$k})){
$to->{$k}=$v;
} elsif(ref($to->{$k}) ne $r){
CORE::warn("\e[31;01mRef mismatch, '".ref($to->{$k})."' ne '$r'!\e[0m");
} elsif(!$r){
$to->{$k}=$v;
} elsif($r eq 'HASH'){
_mergequeries($to->{$k}, $v);
} elsif($r eq 'ARRAY'){
push @{$to->{$k}}, @$v;
} else {
CORE::warn("\e[31;01mUnknown ref type '$r'!\e[0m");
}
}
}
=pod
=item $api->iterator( key => value, ... )
This function returns an iterator object which iterates over the results of a
query. Use it something like this:
my $iter = $api->iterator( %q )
while(my $res = $iter->next()){
# Do stuff
}
Note that, in order to be iterable, the query must return exactly one node
under C<< $res->{'query'} >>, which must be an arrayref or a hashref.
In addition, exactly one value in the query may be an arrayref. In this case,
the query will be iterated to completion in turn for each of the values. For
example,
$api->iterator( titles => ['foo', 'bar', 'baz'], prop => 'info' )
will first query the info for foo, then bar, then baz.
See A
=cut
sub iterator {
return AnomieBOT::API::Iterator->new(@_);
}
=pod
=item $api->paramLimit( $module, $param )
Return the multi-value limit for a parameter.
Returns the limit as an integer, or 0 if there is no limit defined, or an API
error response on error.
=cut
sub paramLimit {
my ($self, $module, $param) = @_;
unless ( exists($self->{'paramlimits'}{$module}) ) {
my $res=$self->_query(action=>'paraminfo', modules=>$module);
return $res unless $res->{'code'} eq 'success';
for my $p (@{$res->{'paraminfo'}{'modules'}[0]{'parameters'}}) {
$self->{'paramlimits'}{$module}{$p->{'name'}} = +$p->{'limit'} if exists($p->{'limit'}) && $p->{'limit'}=~/^\d+$/;
}
}
return $self->{'paramlimits'}{$module}{$param} // 0;
}
=pod
=item $api->login()
=item $api->login( $force )
Try to log the bot in.
Note that the MediaWiki API doesn't actually return an error when the login
fails, but it does return a C
This is translated into a 'notloggedin' error code.
By default, login will return an empty success response if it determines that
the bot is already logged in. You can override this by specifying a
L
=cut
sub login {
my ($self, $force) = @_;
my ($ret);
return {
code => 'notconfigured',
error => 'No password is configured, cannot log in',
} if $self->{'lgpass'} =~ /^\s*$/;
if(!$force){
$self->_throttle('read');
$ret=$self->_query(action=>'query', meta=>'userinfo', maxlag => 600, __noassert => 1);
return {
code => 'success',
error => 'Already logged in',
} if($ret->{'code'} eq 'success' && $ret->{'query'}{'userinfo'}{'name'} eq $self->{'lguser'});
}
$self->_throttle('read');
my $r=$self->_query(
action => 'query',
meta => 'tokens',
type => 'login',
__noassert => 1,
);
return $r if($r->{'code'} ne 'success');
my %q=(
__nolog => 1,
__noassert => 1,
action => 'login',
lgname => $self->{'lguser'},
lgpassword => $self->{'lgpass'},
maxlag => 600,
);
$q{'lgtoken'} = $r->{'query'}{'tokens'}{'logintoken'} if exists( $r->{'query'}{'tokens'}{'logintoken'} );
$self->_throttle('read');
for(my $loops=0; $loops<2; $loops++){
$ret=$self->_query(%q);
$self->{'ua'}->cookie_jar->save();
$self->warn("Login failed ($ret->{code})") if($ret->{'code'} ne 'success');
return $ret if($ret->{'code'} ne 'success');
return $ret if($ret->{'login'}{'result'} eq 'Success');
# Not really logged in. Did we get a login token?
if($ret->{'login'}{'result'} eq 'NeedToken'){
if(!exists($ret->{'login'}{'token'})){
$ret->{'code'}='notloggedin';
$ret->{'error'}='MediaWiki reported NeedToken but did not give us one';
}
$q{'lgtoken'}=$ret->{'login'}{'token'};
redo;
}
# Not really logged in. Did MW say to wait?
my $w=0;
$w=$ret->{'login'}{'wait'} if exists($ret->{'login'}{'wait'});
last if $w<=0;
# Yes they did, do so and try again.
$self->warn("Login failed (".($ret->{'login'}{'result'} // '"success"').") with a wait time, waiting $w seconds");
sleep($w);
}
# Too many retries failed. Just error out now.
$ret->{'code'}='notloggedin';
$ret->{'error'}='MediaWiki reported '.($ret->{'login'}{'result'} // '"success"').', but did not return a login token or a wait time.';
return $ret;
}
=pod
=item $api->logout()
Log the bot out.
=cut
sub logout {
my ($self) = @_;
my ($ret);
$self->_throttle('read');
$ret = $self->_query( action => 'query', meta => 'tokens|userinfo', maxlag => 600, __noassert => 1);
return $ret if $ret->{'code'} ne 'success';
return {
code => 'success',
error => 'Already logged out',
} if exists( $ret->{'query'}{'userinfo'}{'anon'} ) || exists( $ret->{'query'}{'userinfo'}{'temp'} );
$ret = $self->_query( action=>'logout', token => $ret->{'query'}{'tokens'}{'csrftoken'}, __noassert => 1 );
$self->{'ua'}->cookie_jar->save();
return $ret;
}
=pod
=item $api->gettoken( $type )
=item $api->gettoken( $type, %options )
Obtain a token of the specified type (see the C
options are:
=over
=item Title
In addition to the token, fetch information for the specified title.
=item Redir
Follow redirects, if C