File Coverage

blib/lib/MediaWiki/Bot.pm

Criterion	Covered	Total	%
statement	776	1103	70.3
branch	294	602	48.8
condition	55	169	32.5
subroutine	62	78	79.4
pod	58	58	100.0
total	1245	2010	61.9

package MediaWiki::Bot;
use strict;
use warnings;
# ABSTRACT: a high-level bot framework for interacting with MediaWiki wikis
our $VERSION = '5.006003'; # VERSION

use HTML::Entities 3.28;
use Carp;
use Digest::MD5 2.39 qw(md5_hex);
use Encode qw(encode_utf8);
use MediaWiki::API 0.36;
use List::Util qw(sum);
use MediaWiki::Bot::Constants qw(:all);

use Exporter qw(import);
our @EXPORT_OK = @{ $MediaWiki::Bot::Constants::EXPORT_TAGS{all} };
our %EXPORT_TAGS = ( constants => \@EXPORT_OK );

use Module::Pluggable search_path => [qw(MediaWiki::Bot::Plugin)], 'require' => 1;
foreach my $plugin (__PACKAGE__->plugins) {
    #print "Found plugin $plugin\n";
    $plugin->import();
}


sub new {
    my $package = shift;
    my $agent;
    my $assert;
    my $operator;
    my $maxlag;
    my $protocol;
    my $host;
    my $path;
    my $login_data;
    my $debug;

    if (ref $_[0] eq 'HASH') {
        $agent      = $_[0]->{agent};
        $assert     = $_[0]->{assert};
        $operator   = $_[0]->{operator};
        $maxlag     = $_[0]->{maxlag};
        $protocol   = $_[0]->{protocol};
        $host       = $_[0]->{host};
        $path       = $_[0]->{path};
        $login_data = $_[0]->{login_data};
        $debug      = $_[0]->{debug};
    }
    else {
        warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
            . 'the constructor is deprecated and will be removed in a future release')
            if @_;
        $agent    = shift;
        $assert   = shift;
        $operator = shift;
        $maxlag   = shift;
        $protocol = shift;
        $host     = shift;
        $path     = shift;
        $debug    = shift;
    }

    $assert   =~ s/[&?]assert=// if $assert; # Strip out param part, leaving just the value
    $operator =~ s/^User://i     if $operator;

    if (not $agent and not $operator) {
        carp q{You should provide either a customized user agent string }
            . q{(see https://meta.wikimedia.org/wiki/User-agent_policy) }
            . q{or provide your username as `operator'.};
    }
    elsif (not $agent and $operator) {
        $operator =~ s{^User:}{};
        $agent = sprintf(
            'Perl MediaWiki::Bot/%s (%s; [[User:%s]])',
            (defined __PACKAGE__->VERSION ? __PACKAGE__->VERSION : 'dev'),
            'https://metacpan.org/MediaWiki::Bot',
            $operator
        );
    }

    my $self = bless({}, $package);
    $self->{errstr}   = '';
    $self->{assert}   = $assert if $assert;
    $self->{operator} = $operator;
    $self->{debug}    = $debug || 0;
    $self->{api}      = MediaWiki::API->new({
        max_lag         => (defined $maxlag ? $maxlag : 5),
        max_lag_delay   => 5,
        max_lag_retries => 5,
        retries         => 5,
        retry_delay     => 10, # no infinite loops
        use_http_get    => 1,  # use HTTP GET to make certain requests cacheable
    });
    $self->{api}->{ua}->agent($agent) if defined $agent;

    # Set wiki (handles setting $self->{host} etc)
    $self->set_wiki({
            protocol => $protocol,
            host     => $host,
            path     => $path,
    });

    # Log-in, and maybe autoconfigure
    if ($login_data) {
        my $success = $self->login($login_data);
        if ($success) {
            return $self;
        }
        else {
            carp "Couldn't log in with supplied settings" if $self->{debug};
            return;
        }
    }

    return $self;
}


sub set_wiki {
    my $self = shift;
    my $host;
    my $path;
    my $protocol;

    if (ref $_[0] eq 'HASH') {
        $host     = $_[0]->{host};
        $path     = $_[0]->{path};
        $protocol = $_[0]->{protocol};
    }
    else {
        warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
            . 'set_wiki is deprecated, and will be removed in a future release');
        $host = shift;
        $path = shift;
    }

    # Set defaults
    $protocol = $self->{protocol} || 'https'            unless defined($protocol);
    $host     = $self->{host}     || 'en.wikipedia.org' unless defined($host);
    $path     = $self->{path}     || 'w'                unless defined($path);

    # Clean up the parts we will build a URL with
    $protocol =~ s,://$,,;
    if ($host =~ m,^(http|https)(://)?, && !$protocol) {
        $protocol = $1;
    }
    $host =~ s,^https?://,,;
    $host =~ s,/$,,;
    $path =~ s,/$,,;

    # Invalidate wiki-specific cached data
    if (   ((defined($self->{host})) and ($self->{host} ne $host))
        or ((defined($self->{path})) and ($self->{path} ne $path))
        or ((defined($self->{protocol})) and ($self->{protocol} ne $protocol))
    ) {
        delete $self->{ns_data} if $self->{ns_data};
        delete $self->{ns_alias_data} if $self->{ns_alias_data};
    }

    $self->{protocol} = $protocol;
    $self->{host}     = $host;
    $self->{path}     = $path;

    $self->{api}->{config}->{api_url} = $path
        ? "$protocol://$host/$path/api.php"
        : "$protocol://$host/api.php"; # $path is '', so don't use http://domain.com//api.php
    warn "Wiki set to " . $self->{api}->{config}{api_url} . "\n" if $self->{debug} > 1;

    return RET_TRUE;
}


sub login {
    my $self = shift;
    my $username;
    my $password;
    my $lgdomain;
    my $autoconfig;
    my $basic_auth;
    my $do_sul;
    if (ref $_[0] eq 'HASH') {
        $username   = $_[0]->{username};
        $password   = $_[0]->{password};
        $autoconfig = defined($_[0]->{autoconfig}) ? $_[0]->{autoconfig} : 1;
        $basic_auth = $_[0]->{basic_auth};
        $do_sul     = $_[0]->{do_sul} || 0;
        $lgdomain   = $_[0]->{lgdomain};
    }
    else {
        warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
            . 'login is deprecated and will be removed in a future release');
        $username   = shift;
        $password   = shift;
        $autoconfig = 0;
        $do_sul     = 0;
    }

    # strip off the "@bot_password_label" suffix, if any
    $self->{username} = (split /@/, $username, 2)[0]; # normal human-readable username
    $self->{login_username} = $username; # to be used for login (includes "@bot_password_label")

    carp "Logging in over plain HTTP is a bad idea, we would be sending secrets"
        . " (passwords or cookies) in plaintext over an insecure connection."
        . " To protect against eavesdroppers, set protocol => 'https'"
        unless $self->{protocol} eq 'https';

    # Handle basic auth first, if needed
    if ($basic_auth) {
        warn 'Applying basic auth credentials' if $self->{debug} > 1;
        $self->{api}->{ua}->credentials(
            $basic_auth->{netloc},
            $basic_auth->{realm},
            $basic_auth->{uname},
            $basic_auth->{pass}
        );
    }

    if ($self->{host} eq 'secure.wikimedia.org') {
        warnings::warnif('deprecated', 'SSL is now supported on the main Wikimedia Foundation sites. '
            . 'Use en.wikipedia.org (or whatever) instead of secure.wikimedia.org.');
        return;
    }

    if($do_sul) {
        my $sul_success = $self->_do_sul($password);
        warn 'Some or all SUL logins failed' if $self->{debug} > 1 and !$sul_success;
    }

    my $cookies = ".mediawiki-bot-$username-cookies";
    if (-r $cookies) {
        $self->{api}->{ua}->{cookie_jar}->load($cookies);
        $self->{api}->{ua}->{cookie_jar}->{ignore_discard} = 1;
        # $self->{api}->{ua}->add_handler("request_send", sub { shift->dump; return });

        if ($self->_is_loggedin()) {
            $self->_do_autoconfig() if $autoconfig;
            warn 'Logged in successfully with cookies' if $self->{debug} > 1;
            return 1; # If we're already logged in, nothing more is needed
        }
    }

    unless ($password) {
        carp q{Cookies didn't get us logged in, and no password to continue with authentication} if $self->{debug};
        return;
    }

    my $res;
    RETRY: for (1..2) {
        # Fetch a login token
        $res = $self->{api}->api({
            action  => 'query',
            meta    => 'tokens',
            type    => 'login',
        }) or return $self->_handle_api_error();
        my $token = $res->{query}->{tokens}->{logintoken};

        # Do the login
        $res = $self->{api}->api({
            action      => 'login',
            lgname      => $self->{login_username},
            lgpassword  => $password,
            lgdomain    => $lgdomain,
            lgtoken     => $token,
        }) or return $self->_handle_api_error();

        last RETRY if $res->{login}->{result} eq 'Success';
    };

    $self->{api}->{ua}->{cookie_jar}->extract_cookies($self->{api}->{response});
    $self->{api}->{ua}->{cookie_jar}->save($cookies) if (-w($cookies) or -w('.'));

    if ($res->{login}->{result} eq 'Success') {
        if ($res->{login}->{lgusername} eq $self->{username}) {
            $self->_do_autoconfig() if $autoconfig;
            warn 'Logged in successfully with password' if $self->{debug} > 1;
        }
    }

    return ((defined($res->{login}->{lgusername})) and
            (defined($res->{login}->{result})) and
            ($res->{login}->{lgusername} eq $self->{username}) and
            ($res->{login}->{result} eq 'Success'));
}

sub _do_sul {
    my $self     = shift;
    my $password = shift;
    my $debug    = $self->{debug};  # Remember these for later
    my $host     = $self->{host};
    my $path     = $self->{path};
    my $protocol = $self->{protocol};
    my $username = $self->{login_username};

    $self->{debug} = 0;             # Turn off debugging for these internal calls
    my @logins;                     # Keep track of our successes
    my @WMF_projects = qw(
        en.wikipedia.org
        en.wiktionary.org
        en.wikibooks.org
        en.wikinews.org
        en.wikiquote.org
        en.wikisource.org
        en.wikiversity.org
        meta.wikimedia.org
        commons.wikimedia.org
        species.wikimedia.org
        incubator.wikimedia.org
    );

    SUL: foreach my $project (@WMF_projects) { # Could maybe be parallelized
        print STDERR "Logging in on $project..." if $debug > 1;
        $self->set_wiki({
            host    => $project,
        });
        my $success = $self->login({
            username    => $username,
            password    => $password,
            do_sul      => 0,
            autoconfig  => 0,
        });
        warn ($success ? " OK\n" : " FAILED:\n") if $debug > 1;
        warn $self->{api}->{error}->{code} . ': ' . $self->{api}->{error}->{details}
            if $debug > 1 and !$success;
        push(@logins, $success);
    }
    $self->set_wiki({           # Switch back to original wiki
        protocol => $protocol,
        host     => $host,
        path     => $path,
    });

    my $sum = sum 0, @logins;
    my $total = scalar @WMF_projects;
    warn "$sum/$total logins succeeded" if $debug > 1;
    $self->{debug} = $debug; # Reset debug to it's old value

    return $sum == $total;
}


sub logout {
    my $self = shift;

    $self->{api}->api({ action => 'logout' });
    return RET_TRUE;
}


sub edit {
    my $self = shift;
    my $page;
    my $text;
    my $summary;
    my $is_minor;
    my $assert;
    my $markasbot;
    my $section;
    my $captcha_id;
    my $captcha_solution;

    if (ref $_[0] eq 'HASH') {
        $page      = $_[0]->{page};
        $text      = $_[0]->{text};
        $summary   = $_[0]->{summary};
        $is_minor  = $_[0]->{minor};
        $assert    = $_[0]->{assert};
        $markasbot = $_[0]->{markasbot};
        $section   = $_[0]->{section};
        $captcha_id         = $_[0]->{captcha_id};
        $captcha_solution   = $_[0]->{captcha_solution};
    }
    else {
        warnings::warnif('deprecated', 'Please pass a hashref; this method of calling '
            . 'edit is deprecated, and will be removed in a future release.');
        $page      = shift;
        $text      = shift;
        $summary   = shift;
        $is_minor  = shift;
        $assert    = shift;
        $markasbot = shift;
        $section   = shift;
    }

    # Set defaults
    $summary = 'BOT: Changing page text' unless $summary;
    if ($assert) {
        $assert =~ s/^[&?]assert=//;
    }
    else {
        $assert = $self->{assert};
    }
    $is_minor  = 1 unless defined($is_minor);
    $markasbot = 1 unless defined($markasbot);

    # Clear any captcha data that might remain from a previous edit attempt
    delete $self->{error}->{captcha};
    carp 'Need both captcha_id and captcha_solution when editing with a solved CAPTCHA'
        if (defined $captcha_id and not defined $captcha_solution)
        or (defined $captcha_solution and not defined $captcha_id);

    my ($edittoken, $lastedit, $tokentime) = $self->_get_edittoken($page);
    return $self->_handle_api_error() unless $edittoken;

    # HTTP::Message will do this eventually as of 6.03  (RT#75592), so we need
    # to do it here - otherwise, the md5 won't match what eventually is sent to
    # the server, and the edit will fail - GH#39.
    # If HTTP::Message becomes unbroken in the future, might have to keep this
    # workaround for people using 6.03 and other future broken versions.
    $text =~ s{(?
    my $md5 = md5_hex(encode_utf8($text)); # Pass only bytes to md5_hex()
    my $hash = {
        action         => 'edit',
        title          => $page,
        token          => $edittoken,
        text           => $text,
        md5            => $md5,             # Guard against data corruption
        summary        => $summary,
        basetimestamp  => $lastedit,        # Guard against edit conflicts
        starttimestamp => $tokentime,       # Guard against the page being deleted/moved
        bot            => $markasbot,
        ( $section  ? (section => $section) : ()),
        ( $assert   ? (assert => $assert)   : ()),
        ( $is_minor ? (minor => 1)          : (notminor => 1)),
        ( $captcha_id ? (captchaid => $captcha_id) : ()),
        ( $captcha_solution ? (captchaword => $captcha_solution) : ()),
    };

    ### Actually do the edit
    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    if ($res->{edit}->{result} && $res->{edit}->{result} eq 'Failure') {
        # https://www.mediawiki.org/wiki/API:Edit#CAPTCHAs_and_extension_errors
        # You need to solve the CAPTCHA, then retry the request with the ID in
        # this error response and the solution.
        if (exists $res->{edit}->{captcha}) {
            return $self->_handle_api_error({
                code => ERR_CAPTCHA,
                details => 'captcharequired: This action requires that a CAPTCHA be solved',
                captcha => $res->{edit}->{captcha},
            });
        }
        return $self->_handle_api_error();
    }

    return $res;
}


sub move {
    my $self   = shift;
    my $from   = shift;
    my $to     = shift;
    my $reason = shift;
    my $opts   = shift;

    my $hash = {
        action => 'move',
        from   => $from,
        to     => $to,
        reason => $reason,
    };
    $hash->{movetalk}     = $opts->{movetalk}     if defined($opts->{movetalk});
    $hash->{noredirect}   = $opts->{noredirect}   if defined($opts->{noredirect});
    $hash->{movesubpages} = $opts->{movesubpages} if defined($opts->{movesubpages});

    my $res = $self->{api}->edit($hash);
    return $self->_handle_api_error() unless $res;
    return $res; # should we return something more useful?
}


sub get_history {
    my $self      = shift;
    my $pagename  = shift;
    my $limit     = shift || 'max';
    my $rvstartid = shift;
    my $direction = shift;

    my $hash = {
        action  => 'query',
        prop    => 'revisions',
        titles  => $pagename,
        rvprop  => 'ids|timestamp|user|comment|flags',
        rvlimit => $limit
    };

    $hash->{rvstartid} = $rvstartid if ($rvstartid);
    $hash->{direction} = $direction if ($direction);

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;
    my ($id) = keys %{ $res->{query}->{pages} };
    my $array = $res->{query}->{pages}->{$id}->{revisions};

    my @return;
    foreach my $hash (@{$array}) {
        my $revid = $hash->{revid};
        my $user  = $hash->{user};
        my ($timestamp_date, $timestamp_time) = split(/T/, $hash->{timestamp});
        $timestamp_time =~ s/Z$//;
        my $comment = $hash->{comment};
        push(
            @return,
            {
                revid          => $revid,
                user           => $user,
                timestamp_date => $timestamp_date,
                timestamp_time => $timestamp_time,
                comment        => $comment,
                minor          => exists $hash->{minor},
            });
    }
    return @return;
}


sub get_text {
    my $self     = shift;
    my $pagename = shift;
    my $revid    = shift;
    my $section  = shift;

    my $hash = {
        action => 'query',
        titles => $pagename,
        prop   => 'revisions',
        rvprop => 'content',
    };
    $hash->{rvstartid} = $revid   if ($revid);
    $hash->{rvsection} = $section if ($section);

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;
    my ($id, $data) = %{ $res->{query}->{pages} };

    return if $id == PAGE_NONEXISTENT;
    return $data->{revisions}[0]->{'*'}; # the wikitext
}


sub get_id {
    my $self     = shift;
    my $pagename = shift;

    my $hash = {
        action => 'query',
        titles => $pagename,
    };

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;
    my ($id) = %{ $res->{query}->{pages} };
    return if $id == PAGE_NONEXISTENT;
    return $id;
}


sub get_pages {
    my $self  = shift;
    my @pages = (ref $_[0] eq 'ARRAY') ? @{$_[0]} : @_;
    my %return;

    my $hash = {
        action => 'query',
        titles => join('|', @pages),
        prop   => 'revisions',
        rvprop => 'content',
    };

    my $diff;    # Used to track problematic article names
    map { $diff->{$_} = 1; } @pages;

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    foreach my $id (keys %{ $res->{query}->{pages} }) {
        my $page = $res->{query}->{pages}->{$id};
        if ($diff->{ $page->{title} }) {
            $diff->{ $page->{title} }++;
        }
        else {
            next;
        }

        if (defined($page->{missing})) {
            $return{ $page->{title} } = undef;
            next;
        }
        if (defined($page->{revisions})) {
            my $revisions = @{ $page->{revisions} }[0]->{'*'};
            if (!defined $revisions) {
                $return{ $page->{title} } = $revisions;
            }
            elsif (length($revisions) < 150 && $revisions =~ m/\#REDIRECT\s\[\[([^\[\]]+)\]\]/) {    # FRAGILE!
                my $redirect_to = $1;
                $return{ $page->{title} } = $self->get_text($redirect_to);
            }
            else {
                $return{ $page->{title} } = $revisions;
            }
        }
    }

    my $expand = $self->_get_ns_alias_data();
    # Only for those article names that remained after the first part
    # If we're here we are dealing most likely with a WP:CSD type of article name
    for my $title (keys %$diff) {
        if ($diff->{$title} == 1) {
            my @pieces = split(/:/, $title);
            if (@pieces > 1) {
                $pieces[0] = ($expand->{ $pieces[0] } || $pieces[0]);
                my $v = $self->get_text(join ':', @pieces);
                warn "Detected article name that needed expanding $title\n" if $self->{debug} > 1;

                $return{$title} = $v;
                if (defined $v and $v =~ m/\#REDIRECT\s\[\[([^\[\]]+)\]\]/) {
                    $v = $self->get_text($1);
                    $return{$title} = $v;
                }
            }
        }
    }
    return \%return;
}


sub get_image{
    my $self = shift;
    my $name = shift;
    my $options = shift;

    my %sizeparams;
    $sizeparams{iiurlwidth} = $options->{width} if $options->{width};
    $sizeparams{iiurlheight} = $options->{height} if $options->{height};

    my $ref = $self->{api}->api({
          action => 'query',
          titles => $name,
          prop   => 'imageinfo',
          iiprop => 'url|size',
          %sizeparams
    });
    return $self->_handle_api_error() unless $ref;
    my ($pageref) = values %{ $ref->{query}->{pages} };
    return unless defined $pageref->{imageinfo}; # if the image is missing

    my $url = @{ $pageref->{imageinfo} }[0]->{thumburl} || @{ $pageref->{imageinfo} }[0]->{url};
    die "$url should be absolute or something." unless ( $url =~ m{^https?://} );

    my $response = $self->{api}->{ua}->get($url);
    return $self->_handle_api_error() unless ( $response->code == 200 );
    return $response->decoded_content;
}


sub revert {
    my $self     = shift;
    my $pagename = shift;
    my $revid    = shift;
    my $summary  = shift || "Reverting to old revision $revid";

    my $text = $self->get_text($pagename, $revid);
    my $res = $self->edit({
        page    => $pagename,
        text    => $text,
        summary => $summary,
    });

    return $res;
}


sub undo {
    my $self    = shift;
    my $page    = shift;
    my $revid   = shift || croak "No revid given";
    my $summary = shift || "Reverting revision #$revid";
    my $after   = shift;
    $summary = "Reverting edits between #$revid & #$after" if defined($after);    # Is that clear? Correct?

    my ($edittoken, $basetimestamp, $starttimestamp) = $self->_get_edittoken($page);
    my $hash = {
        action         => 'edit',
        title          => $page,
        undo           => $revid,
        (undoafter     => $after)x!! defined $after,
        summary        => $summary,
        token          => $edittoken,
        starttimestamp => $starttimestamp,
        basetimestamp  => $basetimestamp,
    };

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;
    return $res;
}


sub get_last {
    my $self = shift;
    my $page = shift;
    my $user = shift;

    my $res = $self->{api}->api({
            action        => 'query',
            titles        => $page,
            prop          => 'revisions',
            rvlimit       => 1,
            rvprop        => 'ids|user',
            rvexcludeuser => $user || '',
    });
    return $self->_handle_api_error() unless $res;

    my (undef, $data) = %{ $res->{query}->{pages} };
    my $revid = $data->{revisions}[0]->{revid};
    return $revid;
}


sub update_rc {
    warnings::warnif('deprecated', 'update_rc is deprecated, and may be removed '
        . 'in a future release. Please use recentchanges(), which provides more '
        . 'data, including rcid');
    my $self    = shift;
    my $limit   = shift || 'max';
    my $options = shift;

    my $hash = {
        action      => 'query',
        list        => 'recentchanges',
        rcnamespace => 0,
        rclimit     => $limit,
    };
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when using callback

    my @rc_table;
    foreach my $hash (@{$res}) {
        push(
            @rc_table,
            {
                title     => $hash->{title},
                revid     => $hash->{revid},
                old_revid => $hash->{old_revid},
                timestamp => $hash->{timestamp},
            }
        );
    }
    return @rc_table;
}


sub recentchanges {
    my $self = shift;
    my $ns;
    my $limit;
    my $options;
    my $user;
    my $show;
    if (ref $_[0] eq 'HASH') { # unpack for new args
        my %args = %{ +shift };
        $ns     = delete $args{ns};
        $limit  = delete $args{limit};
        $user   = delete $args{user};

        if (ref $args{show} eq 'HASH') {
            my @show;
            while (my ($k, $v) = each %{ $args{show} }) {
                push @show, '!'x!$v . $k;
            }
            $show = join '|', @show;
        }
        else {
            $show = delete $args{show};
        }

        $options = shift;
    }
    else {
        $ns      = shift || 0;
        $limit   = shift || 50;
        $options = shift;
    }
    $ns = join('|', @$ns) if ref $ns eq 'ARRAY';

    my $hash = {
        action      => 'query',
        list        => 'recentchanges',
        rcnamespace => $ns,
        rclimit     => $limit,
        rcprop      => 'user|comment|timestamp|title|ids',
    };
    $hash->{rcuser} = $user if defined $user;
    $hash->{rcshow} = $show if defined $show;

    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options)
        or return $self->_handle_api_error();
    return RET_TRUE unless ref $res; # Not a ref when using callback
    return @$res;
}


sub what_links_here {
    my $self    = shift;
    my $page    = shift;
    my $filter  = shift;
    my $ns      = shift;
    my $options = shift;

    $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');    # Allow array of namespaces
    if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) {    # Verify $filter
        $filter = $1;
    }

    # http://en.wikipedia.org/w/api.php?action=query&list=backlinks&bltitle=template:tlx
    my $hash = {
        action      => 'query',
        list        => 'backlinks',
        bltitle     => $page,
        bllimit     => 'max',
    };
    $hash->{blnamespace}   = $ns if defined $ns;
    $hash->{blfilterredir} = $filter if $filter;
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference
    my @links;
    foreach my $hashref (@$res) {
        my $title    = $hashref->{title};
        my $redirect = defined($hashref->{redirect});
        push @links, { title => $title, redirect => $redirect };
    }

    return @links;
}


sub list_transclusions {
    my $self    = shift;
    my $page    = shift;
    my $filter  = shift;
    my $ns      = shift;
    my $options = shift;

    $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');
    if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) {    # Verify $filter
        $filter = $1;
    }

    # http://en.wikipedia.org/w/api.php?action=query&list=embeddedin&eititle=Template:Stub
    my $hash = {
        action      => 'query',
        list        => 'embeddedin',
        eititle     => $page,
        eilimit     => 'max',
    };
    $hash->{eifilterredir} = $filter if $filter;
    $hash->{einamespace}   = $ns if defined $ns;
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference
    my @links;
    foreach my $hashref (@$res) {
        my $title    = $hashref->{title};
        my $redirect = defined($hashref->{redirect});
        push @links, { title => $title, redirect => $redirect };
    }

    return @links;
}


sub get_pages_in_category {
    my $self     = shift;
    my $category = shift;
    my $options  = shift;

    if ($category =~ m/:/) {    # It might have a namespace name
        my ($cat) = split(/:/, $category, 2);
        if ($cat ne 'Category') {    # 'Category' is a canonical name for ns14
            my $ns_data     = $self->_get_ns_data();
            my $cat_ns_name = $ns_data->{+NS_CATEGORY};
            if ($cat ne $cat_ns_name) {
                $category = "$cat_ns_name:$category";
            }
        }
    }
    else {                                             # Definitely no namespace name, since there's no colon
        $category = "Category:$category";
    }
    warn "Category to fetch is [[$category]]" if $self->{debug} > 1;

    my $hash = {
        action  => 'query',
        list    => 'categorymembers',
        cmtitle => $category,
        cmlimit => 'max',
    };
    $options->{max} = 1 unless defined($options->{max});
    delete($options->{max}) if $options->{max} == 0;

    my $res = $self->{api}->list($hash, $options);
    return RET_TRUE if not ref $res; # Not a hashref when using callback
    return $self->_handle_api_error() unless $res;

    return map { $_->{title} } @$res;
}


{    # Instead of using the state pragma, use a bare block
    my %data;

    sub get_all_pages_in_category {
        my $self          = shift;
        my $base_category = shift;
        my $options       = shift;
        $options->{max} = 0 unless defined($options->{max});

        my @first = $self->get_pages_in_category($base_category, $options);
        %data = () unless $_[0];    # This is a special flag for internal use.
                                    # It marks a call to this method as being
                                    # internal. Since %data is a fake state variable,
                                    # it needs to be cleared for every *external*
                                    # call, but not cleared when the call is recursive.

        my $ns_data     = $self->_get_ns_data();
        my $cat_ns_name = $ns_data->{+NS_CATEGORY};

        foreach my $page (@first) {
            if ($page =~ m/^$cat_ns_name:/) {
                if (!exists($data{$page})) {
                    $data{$page} = '';
                    my @pages = $self->get_all_pages_in_category($page, $options, 1);
                    foreach (@pages) {
                        $data{$_} = '';
                    }
                }
                else {
                    $data{$page} = '';
                }
            }
            else {
                $data{$page} = '';
            }
        }
        return keys %data;
    }
}    # This ends the bare block around get_all_pages_in_category()


sub get_all_categories {
    my $self     = shift;
    my $options  = shift;

    my $query = {
        action => 'query',
        list => 'allcategories',
    };

    if ( defined $options && $options->{'max'} == '0' ) {
        $query->{'aclimit'} = 'max';
    }

    my $res = $self->{api}->api($query);
    return $self->_handle_api_error() unless $res;

    return map { $_->{'*'} } @{ $res->{'query'}->{'allcategories'} };
}


sub linksearch {
    my $self    = shift;
    my $link    = shift;
    my $ns      = shift;
    my $prot    = shift;
    my $options = shift;

    $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');

    my $hash = {
        action      => 'query',
        list        => 'exturlusage',
        euprop      => 'url|title',
        euquery     => $link,
        eulimit     => 'max',
    };
    $hash->{eunamespace} = $ns if defined $ns;
    $hash->{euprotocol}  = $prot if $prot;
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference

    return map {{
        url   => $_->{url},
        title => $_->{title},
    }} @$res;

}


sub purge_page {
    my $self = shift;
    my $page = shift;

    my $hash;
    if (ref $page eq 'ARRAY') {             # If it is an array reference...
        $hash = {
            action => 'purge',
            titles => join('|', @$page),    # dereference it and purge all those titles
        };
    }
    else {                                  # Just one page
        $hash = {
            action => 'purge',
            titles => $page,
        };
    }

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;
    my $success = 0;
    foreach my $hashref (@{ $res->{purge} }) {
        $success++ if exists $hashref->{purged};
    }
    return $success;
}


sub get_namespace_names {
    my $self = shift;
    my $res = $self->{api}->api({
            action => 'query',
            meta   => 'siteinfo',
            siprop => 'namespaces',
    });
    return $self->_handle_api_error() unless $res;
    return map { $_ => $res->{query}->{namespaces}->{$_}->{'*'} }
        keys %{ $res->{query}->{namespaces} };
}


sub image_usage {
    my $self    = shift;
    my $image   = shift;
    my $ns      = shift;
    my $filter  = shift;
    my $options = shift;

    if ($image !~ m/^File:|Image:/) {
        warnings::warnif('deprecated', q{Please include the canonical File: }
            . q{namespace in the image name. If you don't, MediaWiki::Bot might }
            . q{incur a network round-trip to get the localized namespace name});
        my $ns_data = $self->_get_ns_data();
        my $file_ns_name = $ns_data->{+NS_FILE};
        if ($image !~ m/^\Q$file_ns_name\E:/) {
            $image = "$file_ns_name:$image";
        }
    }

    $options->{max} = 1 unless defined($options->{max});
    delete($options->{max}) if $options->{max} == 0;

    $ns = join('|', @$ns) if (ref $ns eq 'ARRAY');

    my $hash = {
        action          => 'query',
        list            => 'imageusage',
        iutitle         => $image,
        iulimit         => 'max',
    };
    $hash->{iunamespace} = $ns if defined $ns;
    if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) {
        $hash->{'iufilterredir'} = $1;
    }
    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # When using a callback hook, this won't be a reference

    return map { $_->{title} } @$res;
}


sub global_image_usage {
    my $self    = shift;
    my $image   = shift;
    my $limit   = shift;
    my $filterlocal = shift;
    $limit = defined $limit ? $limit : 500;

    if ($image !~ m/^File:|Image:/) {
        my $ns_data = $self->_get_ns_data();
        my $image_ns_name = $ns_data->{+NS_FILE};
        if ($image !~ m/^\Q$image_ns_name\E:/) {
            $image = "$image_ns_name:$image";
        }
    }

    my @data;
    my $cont;
    while ($limit ? scalar @data < $limit : 1) {
        my $hash = {
            action          => 'query',
            prop            => 'globalusage',
            titles          => $image,
            # gufilterlocal   => $filterlocal,
            gulimit         => 'max',
        };
        $hash->{gufilterlocal} = $filterlocal if $filterlocal;
        $hash->{gucontinue}    = $cont if $cont;

        my $res = $self->{api}->api($hash);
        return $self->_handle_api_error() unless $res;

        $cont = $res->{'query-continue'}->{globalusage}->{gucontinue};
        warn "gucontinue: $cont\n" if $cont and $self->{debug} > 1;
        my $page_id = (keys %{ $res->{query}->{pages} })[0];
        my $results = $res->{query}->{pages}->{$page_id}->{globalusage};
        push @data, @$results;
        last unless $cont;
    }

    return @data > $limit
        ? @data[0 .. $limit-1]
        : @data;
}


sub links_to_image {
    warnings::warnif('deprecated', 'links_to_image is an alias of image_usage; '
        . 'please use the new name');
    my $self = shift;
    return $self->image_usage($_[0]);
}


sub is_blocked {
    my $self = shift;
    my $user = shift;

    # http://en.wikipedia.org/w/api.php?action=query&meta=blocks&bkusers=$user&bklimit=1&bkprop=id
    my $hash = {
        action  => 'query',
        list    => 'blocks',
        bkusers => $user,
        bklimit => 1,
        bkprop  => 'id',
    };
    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    my $number = scalar @{ $res->{query}->{blocks} }; # The number of blocks returned
    if ($number == 1) {
        return RET_TRUE;
    }
    elsif ($number == 0) {
        return RET_FALSE;
    }
    else {
        confess "This query should return at most one result, but the API returned more than that.";
    }
}


sub test_blocked { # For backwards-compatibility
    warnings::warnif('deprecated', 'test_blocked is an alias of is_blocked; '
        . 'please use the new name. This alias might be removed in a future release');
    return (is_blocked(@_));
}


sub test_image_exists {
    my $self  = shift;
    my $image = shift;

    my $multi;
    if (ref $image eq 'ARRAY') {
        $multi = $image; # so we know to return a hash/scalar & keep track of order
        $image = join('|', @$image);
    }

    my $res = $self->{api}->api({
        action  => 'query',
        titles  => $image,
        iilimit => 1,
        prop    => 'imageinfo'
    });
    return $self->_handle_api_error() unless $res;

    my @sorted_ids;
    if ($multi) {
        my %mapped;
        $mapped{ $res->{query}->{pages}->{$_}->{title} } = $_
            for (keys %{ $res->{query}->{pages} });
        foreach my $file ( @$multi ) {
            unshift @sorted_ids, $mapped{$file};
        }
    }
    else {
        push @sorted_ids, keys %{ $res->{query}->{pages} };
    }
    my @return;
    foreach my $id (@sorted_ids) {
        if ($res->{query}->{pages}->{$id}->{imagerepository} eq 'shared') {
            if ($multi) {
                unshift @return, FILE_SHARED;
            }
            else {
                return FILE_SHARED;
            }
        }
        elsif (exists($res->{query}->{pages}->{$id}->{missing})) {
            if ($multi) {
                unshift @return, FILE_NONEXISTENT;
            }
            else {
                return FILE_NONEXISTENT;
            }
        }
        elsif ($res->{query}->{pages}->{$id}->{imagerepository} eq '') {
            if ($multi) {
                unshift @return, FILE_PAGE_TEXT_ONLY;
            }
            else {
                return FILE_PAGE_TEXT_ONLY;
            }
        }
        elsif ($res->{query}->{pages}->{$id}->{imagerepository} eq 'local') {
            if ($multi) {
                unshift @return, FILE_LOCAL;
            }
            else {
                return FILE_LOCAL;
            }
        }
    }

    return \@return;
}


sub get_pages_in_namespace {
    my $self      = shift;
    my $namespace = shift;
    my $limit     = shift || 'max';
    my $options   = shift;

    my $hash = {
        action      => 'query',
        list        => 'allpages',
        apnamespace => $namespace,
        aplimit     => $limit,
    };
    $options->{max} = 1 unless defined $options->{max};
    delete $options->{max} if exists $options->{max} and $options->{max} == 0;

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when using callback
    return map { $_->{title} } @$res;
}


sub count_contributions {
    my $self     = shift;
    my $username = shift;
    $username =~ s/User://i;    # Strip namespace

    my $res = $self->{api}->list({
            action  => 'query',
            list    => 'users',
            ususers => $username,
            usprop  => 'editcount'
        },
        { max => 1 });
    return $self->_handle_api_error() unless $res;
    return ${$res}[0]->{editcount};
}


sub timed_count_contributions {
    my $self     = shift;
    my $username = shift;
    my $days     = shift;
    $username =~ s/User://i;    # Strip namespace

    my $res = $self->{api}->api({
            action  => 'userdailycontribs',
            user    => $username,
            daysago => $days,
        },
        { max => 1 });
    return $self->_handle_api_error() unless $res;
    return ($res->{userdailycontribs}->{timeFrameEdits}, $res->{userdailycontribs}->{totalEdits});
}


sub last_active {
    my $self     = shift;
    my $username = shift;
    $username = "User:$username" unless $username =~ /User:/i;
    my $res = $self->{api}->list({
            action  => 'query',
            list    => 'usercontribs',
            ucuser  => $username,
            uclimit => 1
        },
        { max => 1 });
    return $self->_handle_api_error() unless $res;
    return ${$res}[0]->{timestamp};
}


sub recent_edit_to_page {
    my $self = shift;
    my $page = shift;
    my $res  = $self->{api}->api({
            action  => 'query',
            prop    => 'revisions',
            titles  => $page,
            rvlimit => 1
        },
        { max => 1 });
    return $self->_handle_api_error() unless $res;
    my $data = ( %{ $res->{query}->{pages} } )[1];
    return ($data->{revisions}[0]->{timestamp},
        $data->{revisions}[0]->{user});
}


sub get_users {
    my $self      = shift;
    my $pagename  = shift;
    my $limit     = shift || 'max';
    my $rvstartid = shift;
    my $direction = shift;

    if ($limit > 50) {
        $self->{errstr} = "Error requesting history for $pagename: Limit may not be set to values above 50";
        carp $self->{errstr};
        return;
    }
    my $hash = {
        action  => 'query',
        prop    => 'revisions',
        titles  => $pagename,
        rvprop  => 'ids|timestamp|user|comment',
        rvlimit => $limit,
    };
    $hash->{rvstartid} = $rvstartid if ($rvstartid);
    $hash->{rvdir}     = $direction if ($direction);

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    my ($id) = keys %{ $res->{query}->{pages} };
    return map { $_->{user} } @{$res->{query}->{pages}->{$id}->{revisions}};
}


sub was_blocked {
    my $self = shift;
    my $user = shift;
    $user =~ s/User://i;    # Strip User: prefix, if present

    # http://en.wikipedia.org/w/api.php?action=query&list=logevents&letype=block&letitle=User:127.0.0.1&lelimit=1&leprop=ids
    my $hash = {
        action  => 'query',
        list    => 'logevents',
        letype  => 'block',
        letitle => "User:$user",    # Ensure the User: prefix is there!
        lelimit => 1,
        leprop  => 'ids',
    };

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    my $number = scalar @{ $res->{query}->{logevents} };    # The number of blocks returned
    if ($number == 1) {
        return RET_TRUE;
    }
    elsif ($number == 0) {
        return RET_FALSE;
    }
    else {
        confess "This query should return at most one result, but the API returned more than that.";
    }
}


sub test_block_hist { # Backwards compatibility
    warnings::warnif('deprecated', 'test_block_hist is an alias of was_blocked; '
        . 'please use the new method name. This alias might be removed in a future release');
    return (was_blocked(@_));
}


sub expandtemplates {
    my $self = shift;
    my $page = shift;
    my $text = shift;

    unless ($text) {
        croak q{You must provide a page title} unless $page;
        $text = $self->get_text($page);
    }

    my $hash = {
        action => 'expandtemplates',
        prop   => 'wikitext',
        ( $page ? (title  => $page) : ()),
        text   => $text,
    };
    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    return exists $res->{expandtemplates}->{'*'}
        ? $res->{expandtemplates}->{'*'}
        : $res->{expandtemplates}->{wikitext};
}


sub get_allusers {
    my $self   = shift;
    my $limit  = shift || 'max';
    my $group  = shift;
    my $opts   = shift;

    my $hash = {
            action  => 'query',
            list    => 'allusers',
            aulimit => $limit,
    };
    $hash->{augroup} = $group if defined $group;
    $opts->{max} = 1 unless exists $opts->{max};
    delete $opts->{max} if exists $opts->{max} and $opts->{max} == 0;
    my $res = $self->{api}->list($hash, $opts);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when using callback

    return map { $_->{name} } @$res;
}


sub db_to_domain {
    my $self = shift;
    my $wiki = shift;

    if (!$self->{sitematrix}) {
        $self->_get_sitematrix();
    }

    if (ref $wiki eq 'ARRAY') {
        my @return;
        foreach my $w (@$wiki) {
            $wiki =~ s/_p$//;                               # Strip off a _p suffix, if present
            my $domain = $self->{sitematrix}->{$w} || undef;
            $domain =~ s/^https\:\/\/// if (defined $domain); # Strip off a https:// prefix, if present
            push(@return, $domain);
        }
        return \@return;
    }
    else {
        $wiki =~ s/_p$//;                                   # Strip off a _p suffix, if present
        my $domain = $self->{sitematrix}->{$wiki} || undef;
        $domain =~ s/^https\:\/\/// if (defined $domain);   # Strip off a https:// prefix, if present
        return $domain;
    }
}


sub domain_to_db {
    my $self = shift;
    my $wiki = shift;

    if (!$self->{sitematrix}) {
        $self->_get_sitematrix();
    }

    if (ref $wiki eq 'ARRAY') {
        my @return;
        foreach my $w (@$wiki) {
            $w = "https://".$w if ($w !~ /^https\:\//); # Prepend a https:// prefix, if not present
            my $db = $self->{sitematrix}->{$w} || undef;
            push(@return, $db);
        }
        return \@return;
    }
    else {
        $wiki = "https://".$wiki if ($wiki !~ /^https\:\//); # Prepend a https:// prefix, if not present
        my $db = $self->{sitematrix}->{$wiki} || undef;
        return $db;
    }
}


sub diff {
    my $self = shift;
    my $title;
    my $revid;
    my $oldid;

    if (ref $_[0] eq 'HASH') {
        $title = $_[0]->{title};
        $revid = $_[0]->{revid};
        $oldid = $_[0]->{oldid};
    }
    else {
        $title = shift;
        $revid = shift;
        $oldid = shift;
    }

    my $hash = {
        action   => 'query',
        prop     => 'revisions',
        rvdiffto => $oldid,
    };
    if ($title) {
        $hash->{titles}  = $title;
        $hash->{rvlimit} = 1;
    }
    elsif ($revid) {
        $hash->{'revids'} = $revid;
    }

    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;
    my @revids = keys %{ $res->{query}->{pages} };
    my $diff   = $res->{query}->{pages}->{ $revids[0] }->{revisions}->[0]->{diff}->{'*'};

    return $diff;
}


sub prefixindex {
    my $self    = shift;
    my $prefix  = shift;
    my $ns      = shift;
    my $filter  = shift;
    my $options = shift;

    if (defined($filter) and $filter =~ m/(all|redirects|nonredirects)/) {    # Verify
        $filter = $1;
    }

    if (!defined $ns && $prefix =~ m/:/) {
        print STDERR "Converted '$prefix' to..." if $self->{debug} > 1;
        my ($name) = split(/:/, $prefix, 2);
        my $ns_data = $self->_get_ns_data();
        $ns = $ns_data->{$name};
        $prefix =~ s/^$name://;
        warn "'$prefix' with a namespace filter $ns" if $self->{debug} > 1;
    }

    my $hash = {
        action   => 'query',
        list     => 'allpages',
        apprefix => $prefix,
        aplimit  => 'max',
    };
    $hash->{apnamespace}   = $ns     if defined $ns;
    $hash->{apfilterredir} = $filter if $filter;
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);

    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when using callback hook

    return map {
        { title => $_->{title}, redirect => defined $_->{redirect} }
    } @$res;
}


sub search {
    my $self    = shift;
    my $term    = shift;
    my $ns      = shift || 0;
    my $options = shift;

    if (ref $ns eq 'ARRAY') {    # Accept a hashref
        $ns = join('|', @$ns);
    }

    my $hash = {
        action   => 'query',
        list     => 'search',
        srsearch => $term,
        srwhat   => 'text',
        srlimit  => 'max',

        #srinfo      => 'totalhits',
        srprop      => 'size',
        srredirects => 0,
    };
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when used with callback

    return map { $_->{title} } @$res;
}


sub get_log {
    my $self    = shift;
    my $data    = shift;
    my $options = shift;

    my $log_type = $data->{type};
    my $user     = $data->{user};
    my $target   = $data->{target};

    if ($user) {
        my $ns_data      = $self->_get_ns_data();
        my $user_ns_name = $ns_data->{+NS_USER};
        $user =~ s/^$user_ns_name://;
    }

    my $hash = {
        action  => 'query',
        list    => 'logevents',
        lelimit => 'max',
    };
    $hash->{letype}  = $log_type if $log_type;
    $hash->{leuser}  = $user     if $user;
    $hash->{letitle} = $target   if $target;
    $options->{max} = 1 unless $options->{max};

    my $res = $self->{api}->list($hash, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when using callback

    return $res;
}


sub is_g_blocked {
    my $self = shift;
    my $ip   = shift;

    # http://en.wikipedia.org/w/api.php?action=query&list=globalblocks&bglimit=1&bgprop=address&bgip=127.0.0.1
    my $res = $self->{api}->api({
            action  => 'query',
            list    => 'globalblocks',
            bglimit => 1,
            bgprop  => 'address',
            # So handy! It searches for blocks affecting this IP or IP range,
            # including rangeblocks! Can't get that from UI.
            bgip    => $ip,
    });
    return $self->_handle_api_error() unless $res;
    return RET_FALSE unless ($res->{query}->{globalblocks}->[0]);

    return $res->{query}->{globalblocks}->[0]->{address};
}


sub was_g_blocked {
    my $self = shift;
    my $ip   = shift;
    $ip =~ s/User://i; # Strip User: prefix, if present

    # This query should always go to Meta
    unless ( $self->{host} eq 'meta.wikimedia.org' ) {
        carp "GlobalBlocking queries should probably be sent to Meta; it doesn't look like you're doing so" if $self->{debug};
    }

    # http://meta.wikimedia.org/w/api.php?action=query&list=logevents&letype=gblblock&letitle=User:127.0.0.1&lelimit=1&leprop=ids
    my $res = $self->{api}->api({
        action  => 'query',
        list    => 'logevents',
        letype  => 'gblblock',
        letitle => "User:$ip",    # Ensure the User: prefix is there!
        lelimit => 1,
        leprop  => 'ids',
    });

    return $self->_handle_api_error() unless $res;
    my $number = scalar @{ $res->{query}->{logevents} };    # The number of blocks returned

    if ($number == 1) {
        return RET_TRUE;
    }
    elsif ($number == 0) {
        return RET_FALSE;
    }
    else {
        confess "This query should return at most one result, but the API gave more than that.";
    }
}


sub was_locked {
    my $self = shift;
    my $user = shift;

    # This query should always go to Meta
    unless (
        $self->{api}->{config}->{api_url} =~ m,
            \Qhttp://meta.wikimedia.org/w/api.php\E
                |
            \Qhttps://secure.wikimedia.org/wikipedia/meta/w/api.php\E
        ,x    # /x flag is pretty awesome :)
        )
    {
        carp "CentralAuth queries should probably be sent to Meta; it doesn't look like you're doing so" if $self->{debug};
    }

    $user =~ s/^User://i;
    $user =~ s/\@global$//i;
    my $res = $self->{api}->api({
            action  => 'query',
            list    => 'logevents',
            letype  => 'globalauth',
            letitle => "User:$user\@global",
            lelimit => 1,
            leprop  => 'ids',
    });
    return $self->_handle_api_error() unless $res;
    my $number = scalar @{ $res->{query}->{logevents} };
    if ($number == 1) {
        return RET_TRUE;
    }
    elsif ($number == 0) {
        return RET_FALSE;
    }
    else {
        confess "This query should return at most one result, but the API returned more than that.";
    }
}


sub get_protection {
    my $self = shift;
    my $page = shift;
    if (ref $page eq 'ARRAY') {
        $page = join('|', @$page);
    }

    my $hash = {
        action => 'query',
        titles => $page,
        prop   => 'info',
        inprop => 'protection',
    };
    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless $res;

    my $data = $res->{query}->{pages};

    my $out_data;
    foreach my $item (keys %$data) {
        my $title      = $data->{$item}->{title};
        my $protection = $data->{$item}->{protection};
        if (@$protection == 0) {
            $protection = undef;
        }
        $out_data->{$title} = $protection;
    }

    if (scalar keys %$out_data == 1) {
        return $out_data->{$page};
    }
    else {
        return $out_data;
    }
}


sub is_protected {
    warnings::warnif('deprecated', 'is_protected is deprecated, and might be '
        . 'removed in a future release; please use get_protection instead');
    my $self = shift;
    return $self->get_protection(@_);
}


sub patrol {
    my $self = shift;
    my $rcid = shift;

    if (ref $rcid eq 'ARRAY') {
        my @return;
        foreach my $id (@$rcid) {
            my $res = $self->patrol($id);
            push(@return, $res);
        }
        return @return;
    }
    else {
        my ($token) = $self->_get_edittoken('patrol');
        my $res = $self->{api}->api({
            action  => 'patrol',
            rcid    => $rcid,
            token   => $token,
        });
        return $self->_handle_api_error()
            if !$res
            or $self->{error}->{details} && $self->{error}->{details} =~ m/^(?:permissiondenied|badtoken)/;

        return $res;
    }
}


sub email {
    my $self    = shift;
    my $user    = shift;
    my $subject = shift;
    my $body    = shift;

    if (ref $user eq 'ARRAY') {
        my @return;
        foreach my $target (@$user) {
            my $res = $self->email($target, $subject, $body);
            push(@return, $res);
        }
        return @return;
    }

    $user =~ s/^User://;
    if ($user =~ m/:/) {
        my $user_ns_name = $self->_get_ns_data()->{+NS_USER};
        $user =~ s/^$user_ns_name://;
    }

    my ($token) = $self->_get_edittoken;
    my $res = $self->{api}->api({
        action  => 'emailuser',
        target  => $user,
        subject => $subject,
        text    => $body,
        token   => $token,
    });
    return $self->_handle_api_error() unless $res;
    return $res;
}


sub top_edits {
    my $self    = shift;
    my $user    = shift;
    my $options = shift;

    $user =~ s/^User://;

    $options->{max} = 1 unless defined($options->{max});
    delete($options->{max}) if $options->{max} == 0;

    my $res = $self->{'api'}->list({
        action  => 'query',
        list    => 'usercontribs',
        ucuser  => $user,
        ucprop  => 'title|flags',
        uclimit => 'max',
    }, $options);
    return $self->_handle_api_error() unless $res;
    return RET_TRUE if not ref $res; # Not a ref when using callback

    return
        map { $_->{title} }
        grep { exists $_->{top} }
        @$res;
}


sub contributions {
    my $self = shift;
    my $user = shift;
    my $ns   = shift;
    my $opts = shift;

    if (ref $user eq 'ARRAY') {
        $user = join '|', map { my $u = $_; $u =~ s{^User:}{}; $u } @$user;
    }
    else {
        $user =~ s{^User:}{};
    }
    $ns = join '|', @$ns
        if ref $ns eq 'ARRAY';

    $opts->{max} = 1 unless defined($opts->{max});
    delete($opts->{max}) if $opts->{max} == 0;

    my $query = {
        action      => 'query',
        list        => 'usercontribs',
        ucuser      => $user,
        ( defined $ns ? (ucnamespace => $ns) : ()),
        ucprop      => 'ids|title|timestamp|comment|flags',
        uclimit     => 'max',
    };
    my $res = $self->{api}->list($query, $opts);
    return $self->_handle_api_error() unless $res->[0];
    return RET_TRUE if not ref $res; # Not a ref when using callback

    return @$res;
}


sub upload {
    my $self = shift;
    my $args = shift;

    my $data = delete $args->{data};
    if (!defined $data and defined $args->{file}) {
            $data = do { local $/; open my $in, '<:raw', $args->{file} or die $!; <$in> };
    }
    unless (defined $data) {
        $self->{error}->{code} = ERR_PARAMS;
        $self->{error}->{details} = q{You must provide either file contents or a filename.};
        return undef;
    }
    unless (defined $args->{file} or defined $args->{title}) {
        $self->{error}->{code} = ERR_PARAMS;
        $self->{error}->{details} = q{You must specify a title to upload to.};
        return undef;
    }

    my $filename = $args->{title} || do { require File::Basename; File::Basename::basename($args->{file}) };
    my $success = $self->{api}->edit({
        action   => 'upload',
        filename => $filename,
        comment  => $args->{summary},
        file     => [ undef, $filename, Content => $data ],
    }) || return $self->_handle_api_error();
    return $success;
}


sub upload_from_url {
    my $self = shift;
    my $args = shift;

    my $url  = delete $args->{url};
    unless (defined $url) {
        $self->{error}->{code} = ERR_PARAMS;
        $self->{error}->{details} = q{You must provide URL of file to upload.};
        return undef;
    }

    my $filename = $args->{title} || do {
        require File::Basename;
        File::Basename::basename($url)
    };
    my $success = $self->{api}->edit({
        action   => 'upload',
        filename => $filename,
        comment  => $args->{summary},
        url      => $url,
        ignorewarnings => 1,
    }) || return $self->_handle_api_error();
    return $success;
}



sub usergroups {
    my $self = shift;
    my $user = shift;

    $user =~ s/^User://;

    my $res = $self->{api}->api({
        action  => 'query',
        list    => 'users',
        ususers => $user,
        usprop  => 'groups',
        ustoken => 'userrights',
    });
    return $self->_handle_api_error() unless $res;

    foreach my $res_user (@{ $res->{query}->{users} }) {
        next unless $res_user->{name} eq $user;

        # Cache the userrights token on the assumption that we'll use it shortly to change the rights
        $self->{userrightscache} = {
            user    => $user,
            token   => $res_user->{userrightstoken},
            groups  => $res_user->{groups},
        };

        return @{ $res_user->{groups} }; # SUCCESS
    }

    return $self->_handle_api_error({ code => ERR_API, details => qq{Results for $user weren't returned by the API} });
}


################
# Internal use #
################

sub _get_edittoken { # Actually returns ($token, $base_timestamp, $start_timestamp)
    my $self = shift;
    my $page = shift || 'Main Page';
    my $type = shift || 'csrf';

    my $res = $self->{api}->api({
        action  => 'query',
        meta => 'siteinfo|tokens',
        titles  => $page,
        prop    => 'revisions',
        rvprop  => 'timestamp',
        type => $type,
    }) or return $self->_handle_api_error();

    my $data            = ( %{ $res->{query}->{pages} })[1];
    my $base_timestamp  = $data->{revisions}[0]->{timestamp};
    my $start_timestamp = $res->{query}->{general}->{time};
    my $token           = $res->{query}->{tokens}->{"${type}token"};

    return ($token, $base_timestamp, $start_timestamp);
}

sub _handle_api_error {
    my $self  = shift;
    my $error = shift;

    $self->{error} = {};

    carp 'Error code '
        . $self->{api}->{error}->{code}
        . ': '
        . $self->{api}->{error}->{details} if $self->{debug};
    $self->{error} =
        (defined $error and ref $error eq 'HASH' and exists $error->{code} and exists $error->{details})
        ? $error
        : $self->{api}->{error};

    return undef;
}

sub _is_loggedin {
    my $self = shift;

    my $is    = $self->_whoami() || return $self->_handle_api_error();
    my $ought = $self->{username};
    warn "Testing if logged in: we are $is, and we should be $ought" if $self->{debug} > 1;
    return ($is eq $ought);
}

sub _whoami {
    my $self = shift;

    my $res = $self->{api}->api({
        action => 'query',
        meta   => 'userinfo',
    }) or return $self->_handle_api_error();

    return $res->{query}->{userinfo}->{name};
}

sub _do_autoconfig {
    my $self = shift;

    # http://en.wikipedia.org/w/api.php?action=query&meta=userinfo&uiprop=rights|groups
    my $hash = {
        action => 'query',
        meta   => 'userinfo',
        uiprop => 'rights|groups',
    };
    my $res = $self->{api}->api($hash);
    return $self->_handle_api_error() unless  $res;
    return $self->_handle_api_error() unless  $res->{query};
    return $self->_handle_api_error() unless  $res->{query}->{userinfo};
    return $self->_handle_api_error() unless  $res->{query}->{userinfo}->{name};

    my $is    = $res->{query}->{userinfo}->{name};
    my $ought = $self->{username};

    # Should we try to recover by logging in again? croak?
    carp "We're logged in as $is but we should be logged in as $ought" if ($is ne $ought);

    my @rights            = @{ $res->{query}->{userinfo}->{rights} || [] };
    my $has_bot           = 0;
    my $default_assert    = 'user'; # At a *minimum*, the bot should be logged in.
    foreach my $right (@rights) {
        if ($right eq 'bot') {
            $has_bot        = 1;
            $default_assert = 'bot';
        }
    }

    my @groups = @{ $res->{query}->{userinfo}->{groups} || [] }; # there may be no groups
    my $is_sysop = 0;
    foreach my $group (@groups) {
        if ($group eq 'sysop') {
            $is_sysop = 1;
        }
    }

    unless ($has_bot && !$is_sysop) {
        warn "$is doesn't have a bot flag; edits will be visible in RecentChanges" if $self->{debug} > 1;
    }
    $self->{assert} = $default_assert unless $self->{assert};

    return RET_TRUE;
}

sub _get_sitematrix {
    my $self = shift;

    my $res = $self->{api}->api({ action => 'sitematrix' });
    return $self->_handle_api_error() unless $res;
    my %sitematrix = %{ $res->{sitematrix} };

    # This hash is a monstrosity (see http://sprunge.us/dfBD?pl), and needs
    # lots of post-processing to have a sane data structure :\
    my %by_db;
    SECTION: foreach my $hashref (%sitematrix) {
        if (ref $hashref ne 'HASH') {    # Yes, there are non-hashrefs in here, wtf?!
            if ($hashref eq 'specials') {
                SPECIAL: foreach my $special (@{ $sitematrix{specials} }) {
                    next SPECIAL
                        if (exists($special->{private})
                        or exists($special->{fishbowl}));

                    my $db     = $special->{code};
                    my $domain = $special->{url};
                    $domain =~ s,^http://,,;

                    $by_db{$db}     = $domain;
                }
            }
            next SECTION;
        }

        my $lang = $hashref->{code};

        WIKI: foreach my $wiki_ref ($hashref->{site}) {
            WIKI2: foreach my $wiki_ref2 (@$wiki_ref) {
                my $family = $wiki_ref2->{code};
                my $domain = $wiki_ref2->{url};
                $domain =~ s,^http://,,;

                my $db = $lang . $family;    # Is simple concatenation /always/ correct?

                $by_db{$db}     = $domain;
            }
        }
    }

    # Now filter out closed wikis
    my $response = $self->{api}->{ua}->get('http://noc.wikimedia.org/conf/closed.dblist');
    if ($response->is_success()) {
        my @closed_list = split(/\n/, $response->decoded_content);
        CLOSED: foreach my $closed (@closed_list) {
            delete($by_db{$closed});
        }
    }

    # Now merge in the reverse, so you can look up by domain as well as db
    my %by_domain;
    while (my ($key, $value) = each %by_db) {
        $by_domain{$value} = $key;
    }
    %by_db = (%by_db, %by_domain);

    # This could be saved to disk with Storable. Next time you call this
    # method, if mtime is less than, say, 14d, you could load it from
    # disk instead of over network.
    $self->{sitematrix} = \%by_db;

    return $self->{sitematrix};
}

sub _get_ns_data {
    my $self = shift;

    # If we have it already, return the cached data
    return $self->{ns_data} if exists $self->{ns_data};

    # If we haven't returned by now, we have to ask the API
    my %ns_data = $self->get_namespace_names();
    my %reverse = reverse %ns_data;
    %ns_data = (%ns_data, %reverse);
    $self->{ns_data} = \%ns_data;    # Save for later use

    return $self->{ns_data};
}

sub _get_ns_alias_data {
    my $self = shift;

    return $self->{ns_alias_data} if exists $self->{ns_alias_data};

    my $ns_res = $self->{api}->api({
        action  => 'query',
        meta    => 'siteinfo',
        siprop  => 'namespacealiases|namespaces',
    });

    my %ns_alias_data =
        map {   # Map namespace alias names like "WP" to the canonical namespace name
                # from the "namespaces" part of the response
            $_->{ns_alias} => $ns_res->{query}->{namespaces}->{ $_->{ns_number} }->{canonical}
        }
        map {   # Map namespace alias names (from the "namespacealiases" part of the response)
                # like "WP" to the namespace number (usd to look up canonical data in the
                # "namespaces" part of the response)
            { ns_alias => $_->{'*'}, ns_number => $_->{id} }
        } @{ $ns_res->{query}->{namespacealiases} };

    $self->{ns_alias_data} = \%ns_alias_data;
    return $self->{ns_alias_data};
}


1;

__END__