User:FairuseBot/Pearle.pm

1. Namespaces available on this wiki

@Pearle::namespaces = ();

$Pearle::logfile = "";

$Pearle::_inited = 0;

$Pearle::username = "";

$Pearle::password = "";

$Pearle::testmode = 0; # Read-only mode: do not actually make wiki-modifying calls, but return as if they succeeded

$Pearle::readonly = 0; # Read-only mode: wiki-modifying calls are errors.

$Pearle::speedLimit = 10; # Seconds to wait by default when limit() is called

$Pearle::_speedMult = 1; # Multiplier for default wait time if the wiki is being slow

$Pearle::roughMode = 0; # Ignore most errors

$Pearle::nullOK = 0; # Permit editing non-existent pages

$Pearle::sanityCheck = 0; # Sanity checking on edits

$Pearle::loglevel = 2; # Level of message to write to file

$Pearle::printlevel = 3; # Level of message to print to stdout

$Pearle::logoutOK = 0; # Permit editing while logged out

$Pearle::proxy = undef; # Proxy to use

$Pearle::wiki = 'https://en.wikipedia.org/w/'; # URL of the directory containing index.php and api.php

$XML::Simple::PREFERRED_PARSER = "XML::Parser"; # Much faster than the default XML::SAX parser

$Pearle::xml_parser = XML::Simple->new();

1. Accessors #########################################################

sub getXMLParser

{

return $Pearle::xml_parser;

}

1. Other functions ###################################################

1. This must be the first function from the library called

sub init

{

$Pearle::username = $_[0] or die("902 No username provided!\n");

$Pearle::password = $_[1] or die("902 No password provided!\n");

$Pearle::logfile = $_[2] or die("902 No logfile name provided!\n");

$Pearle::cookies = $_[3] or die("902 No cookie file provided!\n");

$Pearle::useragent = $_[4] or $Pearle::useragent = "PearleLib/0.2 (User:${Pearle::username})";

$Pearle::ua = LWP::UserAgent->new(timeout => 300);

$Pearle::ua->agent($Pearle::useragent);

$Pearle::ua->cookie_jar(HTTP::Cookies->new(file => $Pearle::cookies, autosave => 1));

$Pearle::ua->cookie_jar->load();

$Pearle::roughMode = "no";

$Pearle::_inited = 1;

}

sub config

{

my %params = @_;

$Pearle::readonly = $params{readonly} if(defined($params{readonly}));

$Pearle::testmode = $params{testmode} if(defined($params{testmode}));

$Pearle::speedLimit = $params{speedLimit} if(defined($params{speedLimit}));

$Pearle::roughMode = $params{roughMode} if(defined($params{roughMode}));

$Pearle::nullOK = $params{nullOK} if(defined($params{nullOK}));

$Pearle::loglevel = $params{loglevel} if(defined($params{loglevel}));

$Pearle::printlevel = $params{printlevel} if(defined($params{printlevel}));

$Pearle::logfile = $params{logfile} if(defined($params{logfile}));

$Pearle::logoutOK = $params{logoutOK} if(defined($params{logoutOK}));

$Pearle::sanityCheck = $params{sanityCheck} if(defined($params{sanityCheck}));

if(defined($params{wiki}) and $params{wiki} ne $Pearle::wiki)

{

$params{wiki} .= '/' if($params{wiki} !~ /\/$/); # Add a trailing slash if needed

$Pearle::wiki = $params{wiki};

}

if(exists($params{proxy}))

{

if(defined($params{proxy}))

{

myLog(3, "Proxying: $params{proxy}\n");

$Pearle::ua->proxy('http', $params{proxy});

$Pearle::proxy = $params{proxy};

}

else

{

myLog(3, "Not proxying\n");

$Pearle::ua->no_proxy();

$Pearle::proxy = undef;

}

}

}

1. Logging levels:
2. 0: Immediately fatal errors. Call to myLog will be followed by a call to die()
3. 1: Non-fatal errors. The library can recover, turn the function call into a no-op, and return an error indicator
4. 2: Serious warning. The library can still complete the action
5. 3: Status messages. Messages useful for tracing library execution.
6. 4: Debugging messages.

sub myLog

{

my $level = shift;

my @message = @_;

my $message = join "", @message;

if($level <= $Pearle::loglevel)

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

open (LOG, ">>:utf8", $Pearle::logfile) || die "900 Could not append to log!";

print LOG $message;

close (LOG);

}

if($level <= $Pearle::printlevel)

{

print $message;

}

}

1. Rate-limiting. Can be sensibly run even if libPearle isn't initialized

sub limit

{

my ($i);

$i = ($_[0] or ($Pearle::speedLimit * $Pearle::_speedMult));

$i = 10 if($i < 10);

# Rate-limiting to avoid hosing the wiki server

# Min 30 sec unmarked

# Min 10 sec marked

# May be raised by retry() if load is heavy

### ATTENTION ###

# Increasing the speed of the bot to faster than 1 edit every 10

# seconds violates English Wikipedia rules as of April, 2005, and

# will cause your bot to be banned. So don't change $normalDelay

# unless you know what you are doing. Other sites may have

# similar policies, and you are advised to check before using your

# bot at the default speed.

#################

while ($i >= 0)

{

sleep (1);

print "Sleeping $i seconds...\r";

$i--;

}

print " \r";

}

sub login

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my $xml = APIPost(action => 'login', lgname => $Pearle::username, lgpassword => $Pearle::password);

my $parsed_xml = $Pearle::xml_parser->XMLin($xml);

print Dumper($parsed_xml);

if($parsed_xml->{login}->{result} eq 'NeedToken')

{

$xml = APIPost(action => 'login', lgname => $Pearle::username, lgpassword => $Pearle::password, lgtoken => $parsed_xml->{login}->{token});

$parsed_xml = $Pearle::xml_parser->XMLin($xml);

print Dumper($parsed_xml);

}

if($parsed_xml->{login}->{result} eq 'Success')

{

return 1;

}

else

{

return 0;

}

}

sub logout {

APIQuery(action => 'logout');

return 1;

}

sub checkLogin

{

my ($reply_text);

$reply_text = $_[0];

if ($reply_text !~ m/>My talk<\/a>/ and !($Pearle::logoutOK))

{

if($reply_text !~ /var wgUserName = "$Pearle::username"/)

{

# We've lost our identity.

myLog(0, "Wiki server is not recognizing me (1).\n---\n${reply_text}\n---\n");

die ("921 Wiki server is not recognizing me (1).\n");

}

}

}

1. Make an HTTP request, performing basic error checking and handling. Suitable for use with the "retry" function

sub httpRequest

{

my ($request, $response, $attemptStartTime, $attemptEndTime);

$request = $_[0];

$response = $Pearle::ua->request($request);

# Monitor wiki server responsiveness

$attemptStartTime = Time::HiRes::time();

if ($response->is_success or $response->is_redirect)

{

return $response

}

else

{

# 50X HTTP errors mean there is a problem connecting to the wiki server. Can be remedied by waiting and trying again

if (500 <= $response->code and 504 >= $response->code)

{

myLog(2, "HTTP ERR (".$response->status_line.")\n");

die("retry:".$response->status_line);

}

else

{

# Unhandled HTTP response. Waiting probably won't fix it

myLog(0, "HTTP ERR (".$response->status_line.")\n".$response->decoded_content."\n");

die($response->status_line."\n");

}

}

# Monitor wiki server responsiveness

$attemptEndTime = Time::HiRes::time();

if($request->method() eq "POST")

{

if (($attemptEndTime - $attemptStartTime) > 20)

{

$Pearle::_speedMult = 60;

myLog(3, "Wiki is very slow. Increasing minimum wait to " . $Pearle::speedLimit * $Pearle::_speedMult . " sec...\n");

}

# If the response time is between 10 and 20 seconds...

elsif (($attemptEndTime - $attemptStartTime) > 10)

{

$Pearle::_speedMult = 6;

myLog(3, "Wiki is somewhat slow. Setting minimum wait to " . $Pearle::speedLimit * $Pearle::_speedMult . " sec...\n");

}

# If the response time is less than 10 seconds...

else

{

if ($Pearle::_speedMult != 1)

{

$Pearle::_speedMult = 1;

myLog(3, "Returning to normal minimum wait time.\n");

}

}

}

}

1. Check out a page for editing.

sub getPage

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($target, $xml, $parsed_xml, %query_params, $text, $editTime, $startTime, $token);

$target = $_[0];

if ($target =~ m/^\s*$/)

{

myLog(0, "getPage: Null target.");

die("902 getPage: Null target.");

}

$query_params{prop} = ['revisions', 'info'];

$query_params{rvprop} = ['timestamp', 'content'];

$query_params{inprop} = 'protection';

$query_params{intoken} = 'edit';

$query_params{titles} = $target;

$xml = APIQuery(%query_params);

if(!defined($xml))

{

myLog(0, "Unknown error requesting page contents\n");

die "900 Unknown error requesting page contents";

}

$parsed_xml = $Pearle::xml_parser->XMLin($xml);

myLog(4, Dumper($parsed_xml));

$xml = undef;

# Check for errors

if(exists($parsed_xml->{query}->{pages}->{page}->{invalid}))

{

myLog(0, "Invalid page title: $target\n");

die("902 Invalid page title: $target");

}

# See if the page is blank

if(!$Pearle::nullOK && exists($parsed_xml->{query}->{pages}->{page}->{missing}))

{

myLog (1, "Empty page: $target\n");

if (!$Pearle::roughMode)

{

die ("920 Empty page: $target\n");

}

}

$text = $parsed_xml->{query}->{pages}->{page}->{revisions}->{rev}->{content};

$startTime = $parsed_xml->{query}->{pages}->{page}->{starttimestamp};

$editTime = $parsed_xml->{query}->{pages}->{page}->{revisions}->{rev}->{timestamp};

$token = $parsed_xml->{query}->{pages}->{page}->{edittoken};

return Pearle::WikiPage->new(text => $text, editTime => $editTime, startTime => $startTime, editToken => $token, title => $target);

}

sub getToken

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($target, $xml, $parsed_xml, %query_params);

$target = $_[0];

if ($target =~ m/^\s*$/)

{

myLog(0, "getPage: Null target.");

die("902 getPage: Null target.");

}

$query_params{prop} = ['info'];

$query_params{intoken} = 'edit';

$query_params{titles} = $target;

$query_params{inprop} = '';

$xml = APIQuery(%query_params);

$parsed_xml = $Pearle::xml_parser->XMLin($xml);

myLog(4, Dumper($parsed_xml));

$xml = undef;

# Check for errors

if(exists($parsed_xml->{query}->{pages}->{page}->{invalid}))

{

myLog(0, "Invalid page title: $target\n");

die("902 Invalid page title: $target");

}

# See if the page has been protected

if(exists($parsed_xml->{query}->{pages}->{page}->{protection}->{pr}))

{

myLog(0, "Page $target is protected\n");

die("925 Protected");

}

return $parsed_xml->{query}->{pages}->{page}->{edittoken};

}

1. The common elements of postPage and appendToPage. Not for external consumption.

sub _editPage

{

die "903 Library in read-only mode!\n" if($Pearle::readonly);

my ($xml, $parsed_xml, $pageName, %params);

%params = @_;

$pageName = $params{title};

$params{assert} = 'user' if(!$Pearle::logoutOK);

EDITRETRY:

$xml = APIEdit(%params);

if(!defined($xml))

{

myLog(0, "Unknown error posting edit\n");

die "900 Unknown error posting edit";

}

$parsed_xml = $Pearle::xml_parser->XMLin($xml);

myLog(4, Dumper($parsed_xml));

$xml = undef;

# Check for errors

if(exists($parsed_xml->{edit}) && $parsed_xml->{edit}->{result} eq 'Failure' && $parsed_xml->{edit}->{assert} eq 'user')

{

myLog(0, "Wiki server is not recognizing me\n");

die ("921 Not logged in");

}

if(exists($parsed_xml->{error}))

{

if($parsed_xml->{error}->{code} eq 'blocked')

{

myLog(0, "Blocked\n");

die ("900 Blocked");

}

elsif($parsed_xml->{error}->{code} eq 'protectedpage' || $parsed_xml->{error}->{code} eq 'cascadeprotected')

{

myLog(0, "Page $pageName is protected\n");

die ("925 Protected");

}

elsif($parsed_xml->{error}->{code} eq 'pagedeleted')

{

myLog(0, "Deleted article conflict on $pageName\n");

die ("923 Deleted article conflict");

}

elsif($parsed_xml->{error}->{code} eq 'editconflict')

{

myLog(0, "Edit conflict on $pageName\n");

die ("922 Edit conflict on $pageName");

}

elsif($parsed_xml->{error}->{code} eq 'spamdetected')

{

myLog(0, "Spam link on $pageName: $parsed_xml->{error}->{info}\n");

die ("924 Spam filter");

}

elsif($parsed_xml->{error}->{code} eq 'readonly')

{

myLog(1, "Wiki is in readonly mode. Waiting before retry\n");

sleep 60;

goto EDITRETRY;

}

else

{

myLog(0, "Unexpected error. Code: $parsed_xml->{error}->{code} Info: $parsed_xml->{error}->{info}\n");

die ("920 Server error");

}

}

return $parsed_xml->{edit}->{result};

}

sub postPage

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($page, $pageName, $summaryEntry, $minor, $bot, $xml, %params, $parsed_xml);

$page = $_[0];

$summaryEntry = $_[1];

$minor = $_[2];

$bot = $_[3];

$bot = 1 if(!defined($bot));

if(!defined($minor))

{

myLog(0, "postPage(): Not enough parameters.\n");

die "902 postPage(): Not enough parameters!\n";

}

if(!$page->isa("Pearle::WikiPage"))

{

myLog(0, "postPage(): First parameter is not a WikiPage object\n");

die "902 postPage(): First parameter is not a WikiPage object\n";

}

if ($summaryEntry eq "")

{

myLog(0, "postPage(): No edit summary provided\n");

die "902 postPage(): No edit summary provided\n";

}

return "Success" if($Pearle::testmode);

$pageName = $page->getTitle();

$params{title} = $pageName;

$params{text} = $page->getWikiText();

$params{token} = $page->getEditToken();

$params{summary} = $summaryEntry;

$params{minor} = 1 if($minor);

$params{starttimestamp} = $page->getStartTime();

$params{basetimestamp} = $page->getEditTime();

$params{bot} = 1 if($bot);

return _editPage(%params);

}

sub appendToPage

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($page, $token, $text, $summary, $minor, $bot, %params, $xml, $parsed_xml);

$page = $_[0];

$token = $_[1];

$text = $_[2];

$summary = $_[3];

$minor = $_[4];

$bot = $_[5];

$bot = 1 if(!defined($bot));

if(!defined($minor))

{

myLog(0, "appendToPage(): Not enough parameters.\n");

die "902 appendToPage(): Not enough parameters!\n";

}

return "Success" if($Pearle::testmode);

$params{title} = $page;

$params{appendtext} = $text;

$params{token} = $token;

$params{summary} = $summary;

$params{minor} = 1 if($minor);

$params{bot} = 1 if($bot);

return _editPage(%params);;

}

1. Get a list of the contents in a given category, filtered by namespace

sub getCategoryContents

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($target, $category_offset, @articles, $xml, $parsed_xml, %query_params,

$numberOfArticles, @namespaces);

$target = shift;

@namespaces = @_;

# Category: prefix is mandatory

if($target !~ /^[Cc]ategory:/)

{

$target = "Category:" . $target;

}

$query_params{list} = 'categorymembers';

$query_params{cmprop} = 'title';

$query_params{cmtitle} = $target;

$query_params{cmlimit} = 500; # If you're a flagged bot, this could be 5000, but we default to 500 for compatibility and to keep memory usage down

$query_params{rawcontinue} = "";

foreach my $namespace (@namespaces)

{

$query_params{cmnamespace} .= "${namespace}|";

}

if(exists($query_params{cmnamespace}) and defined($query_params{cmnamespace}))

{

chop $query_params{cmnamespace};

}

do

{

$xml = APIQuery(%query_params);

if(!defined($xml))

{

myLog(0, "Unknown error accessing wiki\n");

die "900 Unknown error accessing wiki";

}

$parsed_xml = $Pearle::xml_parser->XMLin($xml, ForceArray => ['cm']);

myLog(4, Dumper($parsed_xml));

$xml = undef;

if(exists($parsed_xml->{query}->{categorymembers}->{cm}) and defined($parsed_xml->{query}->{categorymembers}->{cm}))

{

my @set_articles = map {$_->{title}} @{$parsed_xml->{query}->{categorymembers}->{cm}};

push @articles, @set_articles;

}

if(exists($parsed_xml->{'query-continue'}->{categorymembers}->{cmcontinue}))

{

$category_offset = $parsed_xml->{'query-continue'}->{categorymembers}->{cmcontinue};

$category_offset =~ s/&/%26/;

$query_params{cmcontinue} = $category_offset;

}

else

{

$category_offset = undef;

}

sleep (1); # Throttle GETs

}

while(defined($category_offset));

$numberOfArticles = scalar(@articles);

myLog(4, "Got $numberOfArticles articles.\n");

return @articles;

}

sub getCategoryArticles

{

return getCategoryContents($_[0], 0); # Namespace 0: Articles

}

sub getCategoryImages

{

return getCategoryContents($_[0], 6); #Namespace 6: Images

}

sub getSubcategories

{

return getCategoryContents($_[0], 14); # Namespace 14: Categories

}

sub getPageImages

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($target, $list_offset, @images, $xml, $parsed_xml, %query_params);

$target = shift;

die "902 No article provided for getPageImages\n" if(!defined($target));

$query_params{prop} = "images";

$query_params{titles} = $target;

$query_params{imlimit} = 500;

$query_params{rawcontinue} = "";

do

{

$xml = APIQuery(%query_params);

if(!defined($xml))

{

myLog(0, "Unknown error accessing wiki\n");

die "900 Unknown error accessing wiki";

}

$parsed_xml = $Pearle::xml_parser->XMLin($xml, ForceArray => ['im']);

myLog(4, Dumper($parsed_xml));

$xml = undef;

if(exists($parsed_xml->{query}->{pages}->{page}->{images}->{im}) and defined($parsed_xml->{query}->{pages}->{page}->{images}->{im}))

{

my @set_images = map {$_->{title}} @{$parsed_xml->{query}->{pages}->{page}->{images}->{im}};

push @images, @set_images;

}

if(exists($parsed_xml->{'query-continue'}->{images}->{imcontinue}))

{

$list_offset = $parsed_xml->{'query-continue'}->{images}->{imcontinue};

$list_offset =~ s/&/%26/;

$query_params{imcontinue} = $list_offset;

}

else

{

$list_offset = undef;

}

sleep (1); # Throttle GETs

}

while(defined($list_offset));

return @images;

}

1. Get up to $max most recent articles edited by a user

sub getUserArticles

{

die "901 Pearle library not initialized!\n" if(!$Pearle::_inited);

my ($url, $request, $response, $reply, @contribs,

$target, $namespace, $max, $offset);

$target = $_[0];

$max = $_[1];

$offset = $_[2];

$namespace = namespaceToNumber($_[3]);

# Create a request-object

if(defined($namespace))

{

$url = "${Pearle::wiki}index.php?title=Special%3AContributions&limit=${max}&offset=${offset}&target=${target}&namespace=$namespace";

}

else

{

$url = "${Pearle::wiki}index.php?title=Special%3AContributions&limit=${max}&offset=${offset}&target=${target}";

}

myLog(3, "GET $url\n");

$request = HTTP::Request->new(GET => "$url");

$response = startRetry(\&httpRequest, $request);

$reply = $response->decoded_content;

# This detects whether or not we're logged in.

checkLogin($reply);

# Extract the contributions

#