view release on metacpan or  search on metacpan

lib/App/Cerberus/Client.pm  view on Meta::CPAN

package App::Cerberus::Client;
{
  $App::Cerberus::Client::VERSION = '0.08';
}

use strict;
use warnings;
use HTTP::Tiny();
use List::Util qw(shuffle);
use List::MoreUtils qw(uniq );
use JSON();
use Carp;
use Any::URI::Escape;

our $JSON = JSON->new->utf8(1);

#===================================
sub new {
#===================================
    my ( $class, %conf ) = @_;
    my $servers = $conf{servers} || [];
    $servers = [$servers] unless ref $servers eq 'ARRAY';
    croak "No Cerebrus (servers) specified" unless @$servers;

    my $http = HTTP::Tiny->new( timeout => $conf{timeout} || 0.1 );
    bless {
        http    => $http,
        servers => [ shuffle uniq map { s{/?$}{/}; $_ } @$servers ]
    }, $class;
}

#===================================
sub request {
#===================================
    my $self   = shift;
    my %params = @_;
    my %failed;
    my $qs = '?' . join '&',
        map { uri_escape($_) . '=' . uri_escape( $params{$_} ) }
        keys %params;

    my $servers = $self->{servers};

    while (1) {
        my $server = shift @$servers;
        push @$servers, $server;
        last if $failed{$server}++;
        my $response = $self->{http}->get( $server . $qs );
        if ( $response->{success} ) {
            my $content = eval { $JSON->decode( $response->{content} ) }
                or warn "Decoding response from ($server): "
                . ( $@ || 'Unknown' ) . "\n"
                and next;
            return $content;
        }
        my $status = $response->{status};
        warn "Server $server: $status, $response->{reason}"
            . ( $status eq '599' ? ": " . $response->{content} : "\n" );
    }
    return {};
}

1;

# ABSTRACT: A multi-server client for speaking to App::Cerebrus


__END__
=pod

=head1 NAME

App::Cerberus::Client - A multi-server client for speaking to App::Cerebrus

=head1 VERSION

version 0.08

=head1 SYNOPSIS

    use App::Cerberus::Client;

    my $client = App::Cerberus::Client->new(
        servers => 'http://localhost:5000',
    );

    my $client = App::Cerberus::Client->new(
        servers => [
            'http://host1:5000',
            'http://host2:5000',
        ],
        timeout => 0.2
    );

    my $info = $client->request(
        ip => '80.1.2.3,
        ua => 'Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)'
    );