File Coverage

blib/lib/Games/Lacuna/Client/RPC.pm

Criterion	Covered	Total	%
statement	31	33	93.9
branch			n/a
condition			n/a
subroutine	11	11	100.0
pod			n/a
total	42	44	95.4

package Games::Lacuna::Client::RPC;
{
  $Games::Lacuna::Client::RPC::VERSION = '0.003';
}
use 5.0080000;
use strict;
use warnings;
use Carp 'croak';
use Scalar::Util 'weaken';
use Time::HiRes qw( sleep );

use Games::Lacuna::Client;

use IO::Interactive qw( is_interactive );

our @CARP_NOT = qw(
  Games::Lacuna::Client
  Games::Lacuna::Client::Alliance
  Games::Lacuna::Client::Body
  Games::Lacuna::Client::Buildings
  Games::Lacuna::Client::Captcha
  Games::Lacuna::Client::Empire
  Games::Lacuna::Client::Inbox
  Games::Lacuna::Client::Map
  Games::Lacuna::Client::Stats
);

use Exception::Class (
    'LacunaException',
    'LacunaRPCException' => {
        isa         => 'LacunaException',
        description => 'The RPC service generated an error.',
        fields      => [qw(code text)],
    },
);

use namespace::clean;

use Moose;

extends 'JSON::RPC::LWP';

has client => (
  is => 'ro',
  isa => 'Games::Lacuna::Client',
  required => 1,
  weak_ref => 1,
);

# was always called with ( id => "1" )
has '+id_generator' => (
  default => sub{sub{1}},
);

around call => sub {
  my $orig = shift;
  my $self = shift;
  my $uri = shift;
  my $method = shift;
  my $params = shift;


    # Call the method.  If a Captcha error is returned, attempt to handle it
    # and re-call the method, up to 3 times
    my $trying           = 1;
    my $is_interactive   = is_interactive();
    my $try_captcha      = $self->{client}->open_captcha || $self->{client}->prompt_captcha;
    my $captcha_attempts = 0;
    my $res;

    while ($trying) {
        $trying = 0;

        $res = $self->$orig($uri,$method,$params);

        # Throttle per 3.0 changes
        sleep($self->{client}->rpc_sleep) if $self->{client}->rpc_sleep;

        if ($res and $res->has_error
            and $res->error->code eq '1016'
            and $is_interactive
            and $try_captcha
            and ++$captcha_attempts <= 3
        ) {
            my $captcha = $self->{client}->captcha;
            my $browser;

            if ( $self->{client}->open_captcha ) {
                $browser = $captcha->open_in_browser;
            }

            if ( !defined $browser && $self->{client}->prompt_captcha ) {
                $captcha->print_url;
            }

            my $answer = $captcha->prompt_for_solution;

            $captcha->solve($answer);
            $trying = 1;
        }
     }

     if ($self->{client}->{verbose_rpc}) {
         my @tmp = @$params;
         shift @tmp;
         printf("RPC: %s(%s)\n",$method,@tmp);
     }
     $self->{client}->{total_calls}++;
     $self->{client}{call_stats}{$method}++;

     LacunaRPCException->throw(
         error   => "RPC Error (" . $res->error->code . "): " . $res->error->message,
         code    => $res->error->code,
         ## Note we don't use the key 'message'. Exception::Class stringifies based
         ## on "message or error" attribute. For backwards compatiblity we don't
         ## want to change how this object will stringify.
         text    => $res->error->message,
     ) if $res->error;

     return $res->deflate;
};


no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__

=head1 NAME

Games::Lacuna::Client::RPC - The actual RPC client

=head1 SYNOPSIS

  use Games::Lacuna::Client;

=head1 DESCRIPTION

=head1 EXCEPTIONS

=head2 LacunaRPCException

This exception is generated if the RPC call fails. It is an Exception::Class object that has the RPC error details.

Attribute C<< $e->code >> contains the error code. Attribute C<< $e->text >> contains the error text.

=head1 AUTHOR

Steffen Mueller, E<lt>[e-mail]<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 by Steffen Mueller

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.

=cut