package AnomieBOT::API;
use utf8;
use strict;
use JSON;
use Time::HiRes qw/time sleep/;
use LWP::UserAgent;
use Digest::MD5 qw/md5_hex/;
use POSIX;
use Carp;
use Encode qw/encode/;
use Data::Dumper;
use DBI;
use Storable qw/freeze thaw/;
use AnomieBOT::RCFeed;
=pod
=head1 NAME
AnomieBOT::API - AnomieBOT API access class
=head1 SYNOPSIS
use AnomieBOT::API;
my $api = AnomieBOT::API->new('/path/to/config_file');
$api->login();
$res=$api->query(list=>'allpages',apnamespace=>0,aplimit=>10);
=head1 DESCRIPTION
C<AnomieBOT::API> is a class implementing various functions needed by a
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 "page"
property containing the full HTML returned with the error, and a "httpcode"
property with the HTTP response code.
=item jsonerror
The response string could not be decoded. The object will also contain a "raw"
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 edittoken() if the page contains a bot exclusion template that
excludes this bot.
=item shutoff
Returned by edittoken() if the task's shutoff page is triggered.
=back
=item error
A textual description of the error code.
=back
=head1 METHODS
=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. See L<conf.sample.ini> for parameters and defaults.
Botnum is the instance number of this bot, which controls which of the "[bot
#]" sections of the config file is actually used.
=cut
sub new {
my $class = shift;
my %CFG=();
croak "USAGE: AnomieBOT::API->new(\$file, \$botnum)" unless @_==2;
my $botnum=$_[1];
if(open(X, '<:utf8', $_[0])){
my $k='';
while(<X>){
next if /^\s*#/;
s/^\s+|\s+$//g;
next if $_ eq '';
if(/^\[([^\x5b\x5d]+)\]\s*$/o){
$k=$1;
$CFG{$k}={};
} elsif(/^(\S+?)\s*=\s*(.*)/o){
if($k eq ''){
carp $_[0].": No section at line $.";
} else {
$CFG{$k}{$1}=$2;
}
} else {
carp $_[0].": Invalid line at line $.";
}
}
close X;
} else {
carp "Could not open ".$_[0].": $!";
}
carp "Bot instance number $botnum is not configured" unless exists($CFG{"bot $botnum"});
my $self = {
botnum => $botnum,
ua => LWP::UserAgent->new(
agent=>"AnomieBOT 1.0 (no task)",
from=>exists($CFG{"bot $botnum"}{'email'})?$CFG{"bot $botnum"}{'email'}:undef,
cookie_jar=>{},
env_proxy=>1,
),
j => JSON->new->utf8,
task => 'no task',
store => undef,
store_each_idx => {},
host => exists($CFG{"bot $botnum"}{'host'})?$CFG{"bot $botnum"}{'host'}:'en.wikipedia.org',
lguser => exists($CFG{"bot $botnum"}{'lguser'})?$CFG{"bot $botnum"}{'lguser'}:'',
lgpass => exists($CFG{"bot $botnum"}{'lgpass'})?$CFG{"bot $botnum"}{'lgpass'}:'',
rcfeed => undef,
read_throttle => 0,
edit_throttle => 10,
lastread => 0,
lastedit => time(),
debug => exists($CFG{"bot $botnum"}{'DEBUG'})?$CFG{"bot $botnum"}{'DEBUG'}:0,
noedit => undef,
editlimit => undef
};
# Check data directory
if(exists($CFG{"bot $botnum"}{'datadir'})){
$self->{'datadir'}=$CFG{"bot $botnum"}{'datadir'};
} elsif(exists($ENV{'HOME'})){
my $d=$ENV{'HOME'};
$d.='/' unless substr($d,-1) eq '/';
$d.='.anomiebot-data/';
$self->{'datadir'}=$d;
} else {
die "HOME not set, please either set it or specify 'datadir' in the config file\n";
}
$self->{'datadir'}.='/' unless substr($self->{'datadir'},-1) eq '/';
if(!-e $self->{'datadir'}){
die "Data directory ".$self->{'datadir'}." cannot be created: $!\n" unless mkdir($self->{'datadir'});
}
die "Data directory ".$self->{'datadir'}." is not a directory\n" unless -d $self->{'datadir'};
my $t=$self->{'datadir'}.'test';
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);
# Open persistant storage
$CFG{"bot $botnum"}{'store_dsn'}='dbi:SQLite:dbname='.$self->{'datadir'}.'AnomieBOT.db' unless exists($CFG{"bot $botnum"}{'store_dsn'});
$CFG{"bot $botnum"}{'store_user'}='' unless exists($CFG{"bot $botnum"}{'store_user'});
$CFG{"bot $botnum"}{'store_pass'}='' unless exists($CFG{"bot $botnum"}{'store_pass'});
$self->{'store'}=DBI->connect($CFG{"bot $botnum"}{'store_dsn'}, $CFG{"bot $botnum"}{'store_user'}, $CFG{"bot $botnum"}{'store_pass'}, { AutoCommit=>1, RaiseError=>1 });
die "Could not open database\n" unless $self->{'store'};
# This will die if the table doesn't exist
$self->{'store'}->selectrow_array("SELECT 1 FROM AnomieBOT_store");
# Create RCFeed object, but don't actually connect yet
if(exists($CFG{'RC Feed'}) && $CFG{'RC Feed'}{'enable'}){
my $d=exists($CFG{'RC Feed'}{'DEBUG'})?$CFG{'RC Feed'}{'DEBUG'}:0;
$CFG{'RC Feed'}{'Nick'}=$self->{'lguser'} unless exists($CFG{'RC Feed'}{'Nick'});
unless(exists($CFG{'RC Feed'}{'Ircname'})){
my $x=$self->{'lguser'};
$x=~s/([^a-zA-Z0-9 ])/ sprintf('%%%02x', ord($1)) /goe;
$x=~s/ /_/go;
$CFG{'RC Feed'}{'Ircname'}='http://'.$self->{'host'}.'/wiki/User:'.$x;
}
delete $CFG{'RC Feed'}{'enable'};
delete $CFG{'RC Feed'}{'DEBUG'};
$self->{'rcfeed'}=AnomieBOT::RCFeed->new(%{$CFG{'RC Feed'}});
$self->{'rcfeed'}->DEBUG($d);
}
# Copy extra config sections for access by tasks
$self->{'CFG'}={};
while(my ($k,$v)=each %CFG){
next if $k=~/^bot \d+$/;
next if $k eq 'RC Feed';
$self->{'CFG'}{$k}=$v;
}
bless $self, $class;
return $self;
}
=pod
=item $api->DEBUG
=item $api->DEBUG( $flag )
Get/set the DEBUG flag. When debugging is enabled, most methods will output
useful text to standard error.
Returns the old value of the flag.
=cut
sub DEBUG {
my $self=shift;
my $old=$self->{'debug'};
$self->{'debug'}=$_[0]?1:0 if(@_);
return $old;
}
sub DEBUG_OUT {
my $self=shift;
my $msg=shift;
carp "\e[33m".POSIX::strftime('[%F %T] ', localtime).$self->{'task'}.' ('.$self->{'botnum'}.'): '.$msg."\e[0m"
if $self->{'debug'};
}
=pod
=item $api->user
Returns the bot user name.
=cut
sub user {
my $self=shift;
return $self->{'lguser'};
}
=pod
=item $api->task
=item $api->task( $name )
Get/set the current task name. This is used to prefix log lines when debugging
is enabled, and to identify the bot in the User-Agent header.
Returns the old task name.
=cut
sub task {
my $self=shift;
my $old=$self->{'task'};
if(@_){
$self->{'task'}=$_[0];
$self->{'ua'}->agent("AnomieBOT 1.0 (".encode('UTF-8',$self->{'task'}).")");
$self->DEBUG_OUT('Beginning task');
}
return $old;
}
=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->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.
=cut
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_OUT("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 positive floating point number.";
} else {
$self->{'edit_throttle'}=0.0+$n;
$self->DEBUG_OUT("Edit throttle set to $n seconds");
}
}
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->rcfeed
Access the L<AnomieBOT::RCFeed> belonging to this API object. Note this will
return undef unless the C<[RC Feed]> is enabled in the config file.
=cut
sub rcfeed {
return $_[0]->{'rcfeed'};
}
=pod
=item $api->store( $key, $value )
Store the value in the persistant storage corresponding to the current task.
Value may be a scalar or a reference to any datatype supported by perl's
Storable module.
=item $api->fetch( $key )
Fetch a value from the persistant storage corresponding to the current task.
=item $api->nextkey
This is much like perl's L<each|perlfunc/each> function in a scalar context. It
returns the next key in the persistant storage corresponding to the current
task.
=item $api->delete( $key )
Delete a value from the persistant storage corresponding to the current task.
=cut
sub store {
my ($self, $key, $value) = @_;
if($self->{'store'}->selectrow_array("SELECT 1 FROM AnomieBOT_store WHERE task=? AND key=?", {}, $self->{'task'}, $key)){
$self->{'store'}->do("UPDATE AnomieBOT_store SET value=? WHERE task=? AND key=?", {}, freeze($value), $self->{'task'}, $key);
} else {
$self->{'store'}->do("INSERT INTO AnomieBOT_store (value,task,key) VALUES (?,?,?)", {}, freeze($value), $self->{'task'}, $key);
}
}
sub fetch {
my ($self, $key) = @_;
my $value=$self->{'store'}->selectrow_array("SELECT value FROM AnomieBOT_store WHERE task=? AND key=?", {}, $self->{'task'}, $key);
return defined($value)?thaw($value):undef;
}
sub nextkey {
my ($self, $key) = @_;
$self->{'store_each_idx'}{$self->{'task'}}=0 unless exists($self->{'store_each_idx'}{$self->{'task'}});
my $i=$self->{'store_each_idx'}{$self->{'task'}}++;
my $ret=$self->{'store'}->selectrow_array("SELECT key FROM AnomieBOT_store WHERE task=? ORDER BY key LIMIT $i,1", {}, $self->{'task'});
$self->{'store_each_idx'}{$self->{'task'}}=0 unless defined($ret);
return $ret;
}
sub delete {
my ($self, $key) = @_;
my $r=$self->{'store'}->do("DELETE FROM AnomieBOT_store WHERE task=? AND key=?", {}, $self->{'task'}, $key);
if($r!=0){
$self->{'store_each_idx'}{$self->{'task'}}-- if exists($self->{'store_each_idx'}{$self->{'task'}});
$self->{'store_each_idx'}{$self->{'task'}}=0 if $self->{'store_each_idx'}{$self->{'task'}}<0;
}
}
=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 query(), this method may pause for read throttling or maxlag errors.
=cut
sub rawpage {
my @args=@_;
my $self = shift @args;
my $title = shift @args;
my $t=encode('UTF-8', $title);
$t=~s/([^a-zA-Z0-9 ])/ sprintf('%%%02x', ord($1)) /goe;
$t=~s/ /_/go;
my $url;
$url ='http://'.$self->{'host'}.'/w/index.php?';
$url.='title='.$t.'&action=raw&redirect=no&maxlag=5';
my $oldid='';
if(@args){
my $oldid=shift @args;
$oldid=~s/([^a-zA-Z0-9])/ sprintf('%%%02x', ord($1)) /goe;
$url.="&oldid=$oldid";
}
$self->_throttle('read');
my $res=$self->{'ua'}->get($url);
if($res->code==503 &&
$res->decoded_content=~/(Waiting for [^ ]*: [0-9.-]+ seconds lagged)/){
$self->DEBUG_OUT("Pausing for maxlag: $1");
sleep(10);
goto \&rawpage;
}
if($res->code!=200){
$self->DEBUG_OUT("Failed to fetch $title".(($oldid eq '')?'':" ($oldid)").": ".$res->status_line);
return {
code => 'httperror',
httpcode => $res->code,
error => $res->status_line,
page => $res->decoded_content
};
}
$self->DEBUG_OUT("Fetched $title".(($oldid eq '')?'':" ($oldid)"));
return {
code => 'success',
error => 'Success',
content => $res->decoded_content
};
}
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 $raw=exists($param{'format'});
$param{'format'}='json' unless $raw;
$param{'maxlag'}=5 unless exists($param{'maxlag'});
while(my ($k,$v)=each %param){
$param{$k}=encode('UTF-8', $v);
}
my $res=$self->{'ua'}->post('http://'.$self->{'host'}.'/w/api.php', \%param);
my $q='';
if($self->{'debug'}){
$q=Dumper(\%param);
$q=~s/\n\s*/ /g;
}
if($res->code!=200){
$self->DEBUG_OUT("Query failed: ".$res->status_line);
$self->DEBUG_OUT("Failed query was $q");
return {
code => 'httperror',
httpcode => $res->code,
error => $res->status_line,
page => $res->decoded_content
};
}
if($raw){
$self->DEBUG_OUT("Query $q");
return {
code => 'success',
error => 'Success',
content => $res->decoded_content
};
}
my $ret;
eval { $ret=$self->{'j'}->decode($res->decoded_content); };
if($@){
$self->DEBUG_OUT("JSON decoding failed: $@");
$self->DEBUG_OUT("Query $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'){
$self->DEBUG_OUT("Pausing for maxlag: ".$ret->{'error'}{'info'});
sleep(10);
goto \&_query;
} else {
$self->DEBUG_OUT("MediaWiki error: ".$ret->{'error'}{'info'});
$self->DEBUG_OUT("Query $q");
return {
code => $ret->{'error'}{'code'},
error => $ret->{'error'}{'info'}
};
}
}
$self->DEBUG_OUT("Query $q");
$ret->{'code'}='success';
$ret->{'error'}='Success';
return $ret;
}
=pod
=item $api->query( key => value, ... )
Perform a general MediaWiki API query. The keys and values are those needed for
the API query, with the following exceptions:
=over
=item action
If omitted, "query" will be assumed. Do not use "login" or "edit"; use the
provided methods instead.
=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
"content" property of the return object. MediaWiki errors will not be detected.
=item maxlag
If unspecified, the default value "5" will be used. Maxlag errors are
automatically retried.
=back
The return value is normally the API response object, but see above for
details.
=cut
sub query {
my ($self, %param) = @_;
$param{'action'}='query' unless exists($param{'action'});
if($param{'action'} eq 'edit' || $param{'action'} eq 'login'){
my $e="Use AnomieBOT::API->".$param{'action'}." instead of passing action=".$param{'action'}." to AnomieBOT::API->query";
carp $e;
return {
code => 'params',
error => $e
};
}
$self->_throttle('read');
return $self->_query(%param);
}
=pod
=item $api->login()
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 "result" property indicating success or failure.
This is translated into a 'notloggedin' error code.
=cut
sub login {
my ($self) = @_;
my ($ret);
$self->_throttle('read');
for(my $loops=0; $loops<2; $loops++){
$ret=$self->_query(
action => 'login',
lgname => $self->{'lguser'},
lgpassword => $self->{'lgpass'}
);
return $ret if($ret->{'code'} ne 'success');
return $ret if($ret->{'login'}{'result'} eq 'Success');
# 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->DEBUG_OUT("Login failed with a wait time, waiting $w seconds");
sleep($w);
}
# Too many retries failed. Just error out now.
$ret->{'code'}='notloggedin';
$ret->{'error'}='MediaWiki reported '.(exists($ret->{'login'}{'result'})?$ret->{'login'}{'result'}:'"success"').', but did not return a login token or a wait time.';
return $ret;
}
=pod
=item $api->edittoken( $title )
=item $api->edittoken( $title, $redir )
=item $api->edittoken( $title, $redir, $opt )
Obtain an edit token for the specified page. If the intention of this edit is
to leave a notification on a user's talk page, $opt should be the appropriate
token as detailed at [[Template:bots#Message notification opt out]]. If you
want to edit a redirect instead of following it, pass a true value for $redir.
The object returned here must be passed to edit(). The object contains the
following properties:
=over
=item self
The API object this token was generated by.
=item title
Title of the article.
=item ns
Namespace number of the article.
=item starttime
ISO format timestamp of the creation of this edit token.
=item missing
If present, the article does not currently exist.
=item lastrevid
Revision ID for the latest revision to the article, if it exists.
=item revisions
Array with one member, an object with the following properties:
=over
=item revid
Revision ID for the latest revision to the article, if it exists.
=item timestamp
ISO-format timestamp of the latest revision to the article, if it exists.
=item E<32>*
Content of the latest revision to the article, if it exists.
=back
=back
If the bot is not logged in, login() will be automatically attempted; if it
fails, an error code 'notloggedin' will be returned. If the page contains a bot
exclusion template that applies to this bot, an error code 'botexcluded' will
be returned. If the task's shutoff page (User:I<botname>/shutoff/I<task>) is
non-empty, an error code 'shutoff' will be returned.
=cut
sub edittoken {
my ($self, $intitle, $noredir, $opt) = @_;
my ($r);
$self->_throttle('read');
my $shutoff='User:'.$self->{'lguser'}.'/shutoff/'.$self->{'task'};
for(my $loops=0; $loops<2; $loops++){
my $title=$intitle;
my %q=(
action => 'query',
prop => 'info|revisions',
intoken => 'edit',
titles => $title.'|'.$shutoff,
rvprop => 'ids|timestamp|content'
);
$q{'redirects'}=1 unless(defined($noredir) && $noredir);
$r=$self->_query(%q);
return $r if($r->{'code'} ne 'success');
if(exists($r->{'query'}{'normalized'})){
foreach (@{$r->{'query'}{'normalized'}}){
$title=$_->{'to'} if $_->{'from'} eq $title;
}
}
if(exists($r->{'query'}{'redirects'})){
foreach (@{$r->{'query'}{'redirects'}}){
$title=$_->{'to'} if $_->{'from'} eq $title;
}
}
my @r=values(%{$r->{'query'}{'pages'}});
my $r=undef;
foreach (@r){ $r=$_ if $_->{'title'} eq $shutoff; }
if(!defined($r)){
$self->DEBUG_OUT('Shutoff token was not returned. WTF?');
return {
code => 'wtferror',
error => 'Shutoff check failed. WTF?'
};
}
if(!defined($self->{'noedit'}) && !exists($r->{'missing'}) && $r->{'revisions'}[0]{'*'}=~/\S/){
return {
code => 'shutoff',
error => 'Task shutoff',
content => $r->{'revisions'}[0]{'*'}
};
}
$r=undef;
foreach (@r){ $r=$_ if $_->{'title'} eq $title; }
if(!defined($r)){
$self->DEBUG_OUT('Edit token was not returned. WTF?');
return {
code => 'wtferror',
error => 'Edit token was not returned. WTF?'
};
}
if($r->{'edittoken'} eq '+\\'){
$r=$self->login();
return $r if($r->{'code'} ne 'success');
next;
}
# Check bot exclusion
if(!exists($r->{'missing'})){
my $deny='';
while(1){
my $x;
my $c=$r->{'revisions'}[0]{'*'};
if($c=~/(\x7b\x7bnobots\x7d\x7d)/){ $deny=$1; last; }
if($c=~/\x7b\x7bbots\x7d\x7d/){ $deny=''; last; }
if($c=~/\x7b\x7bbots\s*\|\s*allow\s*=\s*all\x7d\x7d/){
$deny=''; last;
}
if($c=~/(\x7b\x7bbots\s*\|\s*allow\s*=\s*none\x7d\x7d)/){
$deny=$1; last;
}
if($c=~/(\x7b\x7bbots\s*\|\s*deny\s*=\s*all\x7d\x7d)/){
$deny=$1; last;
}
if($c=~/\x7b\x7bbots\s*\|\s*deny\s*=\s*none\x7d\x7d/){
$deny=''; last;
}
if($c=~/\x7b\x7bbots\s*\|\s*allow\s*=\s*(.*)\x7d\x7d/){
($x=$1)=~s/^\s+|\s+$|\s*\|.*//;
$x=~s/\s*,\s*/,/g;
unless(grep { $_ eq $self->{'lguser'} } split(/,/, $x)){
$deny="\x7b\x7bbots|allow=...\x7d\x7d without ".$self->{'lguser'};
}
last;
}
if($c=~/\x7b\x7bbots\s*\|\s*deny\s*=\s*(.*)\x7d\x7d/){
($x=$1)=~s/^\s+|\s+$|\s*\|.*//;
$x=~s/\s*,\s*/,/g;
if(grep { $_ eq $self->{'lguser'} } split(/,/, $x)){
$deny="\x7b\x7bbots|deny=...\x7d\x7d with ".$self->{'lguser'};
}
last;
}
if(defined($opt) &&
$c=~/\x7b\x7bbots\s*\|\s*optout\s*=\s*(.*)\x7d\x7d/){
($x=$1)=~s/^\s+|\s+$|\s*\|.*//;
$x=~s/\s*,\s*/,/g;
if(grep { $_ eq $opt } split(/,/, $x)){
$deny="\x7b\x7bbots|optout=...\x7d\x7d with $opt";
last;
}
}
last;
}
if($deny ne ''){
$r->{'code'}='botexcluded';
$r->{'error'}="Found $deny";
delete($r->{'edittoken'});
return $r;
}
}
$r->{'code'}='success';
$r->{'error'}='Success';
$r->{'self'}=$self;
$r->{'starttime'}=POSIX::strftime('%FT%TZ', gmtime);
return $r;
}
# Too many retries failed. Just error out now.
$r->{'code'}='wtferror';
$r->{'error'}='Login seems to succeed but we get no edit token. WTF?';
return $r;
}
=pod
=item $api->edit( $token, $text, $summary, $minor, $bot, $section )
Perform an edit to the page.
=cut
sub edit {
my ($self, $token, $text, $summary, $minor, $bot, $section) = @_;
if(ref($token) ne 'HASH' || $token->{'self'} ne $self){
$self->DEBUG_OUT("Invalid token");
return {
code => 'params',
error => 'Invalid $token'
};
}
my %param=(
action => 'edit',
title => $token->{'title'},
text => $text,
token => $token->{'edittoken'},
summary => $summary,
md5 => md5_hex(encode('UTF-8',$text)),
);
$param{'section'}=$section if defined($section);
$param{$minor?'minor':'notminor'}=1 if defined($minor);
$param{'bot'}=1 if(defined($bot) && $bot);
if(exists($token->{'missing'})){
$param{'basetimestamp'}=_ISO2wptime($token->{'starttime'});
$param{'createonly'}=1;
} else {
$param{'basetimestamp'}=_ISO2wptime($token->{'revisions'}[0]{'timestamp'});
$param{'nocreate'}=1;
}
if(defined($self->{'editlimit'}) && $self->{'editlimit'}<=0){
die "Edit limit reached, bot halting.";
}
$self->_throttle('edit');
if(defined($self->{'noedit'})){
# Fake edit
my $t=$param{'title'}.'<'.(exists($token->{'missing'})?'new':$token->{'lastrevid'}).POSIX::strftime('>%FT%TZ.txt', gmtime);
$t=~s! !_!g;
$t=~s!/!#!g;
$t=$self->{'noedit'}.'/'.$t;
open(X, ">:utf8", $t) or die("Could not open $t: $!\n");
print X $text;
close(X);
print "\e[34mEDIT to ".$param{'title'}." ($summary): $t\e[0m\n";
return {
code => 'success',
error => 'Success',
edit => {
oldrevid => $token->{'lastrevid'},
newrevid => $token->{'lastrevid'},
pageid => $token->{'pageid'},
title => $token->{'title'},
result => 'Success'
}
};
}
my $res=$self->_query(%param);
if($res->{'code'} eq 'success'){
# The edit API might return failure in a different way
if(lc($res->{'edit'}{'result'}) eq 'success'){
$self->{'editlimit'}-- if defined($self->{'editlimit'});
return $res;
}
$res->{'code'}=$res->{'edit'}{'result'};
}
carp "Edit error: ".$res->{'error'};
return $res;
}
sub DESTROY {
my $self=shift;
if(defined($self->{'ua'})){
warn "\e[33m".POSIX::strftime('[%F %T] ', localtime)."no task (".$self->{'botnum'}."): Logging out in destructor\e[0m\n"
if $self->{'debug'};
$self->{'ua'}->post('http://'.$self->{'host'}.'/w/api.php', {action=>'logout'});
} else {
warn "\e[33m".POSIX::strftime('[%F %T] ', localtime)."no task (".$self->{'botnum'}."): Cannot log out in destructor, UA is undefined\e[0m\n"
}
}
1;
=pod
=back
=head1 COPYRIGHT
Copyright 2008 Anomie
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
