view release on metacpan or  search on metacpan

lib/Conductrics/Agent.pm  view on Meta::CPAN

package Conductrics::Agent;

use strict;
use warnings;
use namespace::autoclean;
use Moose;
use MooseX::Types::Moose qw( Str );
use MooseX::Types::URI qw(Uri);
use URI;
use URI::QueryParam;
use JSON::MaybeXS;
use Time::HiRes;
use LWP::UserAgent;
use Data::Dumper;

our $VERSION = '0.004';
$VERSION = eval $VERSION;

sub build_uri { 
    my($self)=@_;
    return URI->new($self->baseUrl); 
}

has 'apiKey' => (is=>'ro', isa=>Str, required=>1);
has 'ownerCode' => (is=>'ro', isa=>Str, required=>1);
has 'baseUrl' => (is=>'ro', isa=>Str, required=>1);
has 'baseUri' => (is=>'ro', isa=>Uri, lazy=>1, builder=>'build_uri');
has 'sessionId' => (is=>'rw', isa=>Str);
has 'name' => (is=>'rw', isa=>Str, required=>1);

my $ua = LWP::UserAgent->new();
$ua->agent('Perl Conductrics::Agent');
$ua->timeout(2);
$ua->env_proxy;

sub _request {
    my ($self, $uri, @params) = @_;
    my ($seconds, $microseconds) = Time::HiRes::gettimeofday;
    my %parameters = (nocache=>"$seconds$microseconds", apikey=>$self->apiKey, session=>$self->sessionId, @params);
    for my $k (keys %parameters) {
	$uri->query_param_append($k, $parameters{$k});
    }

    my $response = $ua->get($uri);
    if ($response->is_success) {
	if ($response->code != 200) {
	    warn "Content: ", $response->decoded_content;  # or whatever
	    warn "Code: ", $response->code;
	    warn "Err:", $response->message;
	    warn "Something get wrong on response";
	    warn Dumper($response);
	}

	JSON::MaybeXS::decode_json($response->decoded_content);
    } else {
	warn "Content: ", $response->decoded_content;  # or whatever
	warn "Code: ", $response->code;
	warn "Err:", $response->message;
	die $response->status_line;
    }
}

sub decide {
    my ($self, $session, @choices) = @_;
    my $uri = $self->baseUri->clone;
    $self->sessionId($session);
    my ($answer, $kind);
    if ('ARRAY' eq ref $choices[0]) {
	# Multi decisions request simple  ([ qw/ red black green / ], [ qw/ verdana arial /] )
	$uri->path_segments($self->ownerCode, $self->name, "decisions", map { join(',', @{$_}) } @choices );
    } elsif ('HASH' eq ref $choices[0]) {
	# Multi decision request with names ( {colour=>[qw/red black green/] }, { font=>[qw/ verdana arial /] })
	$uri->path_segments($self->ownerCode, $self->name, "decisions", map { my ($k) = keys %{$_}; "$k:" . join (",", map {$_} @{$_->{$k}} ) } @choices );
    } else {
	# single decision
	$kind = 'single';
	$uri->path_segments($self->ownerCode, $self->name, "decision", join(',', @choices));
    }
    # handle multidecision answer
    eval {
	$answer = $self->_request(
	    $uri,
	    );
    };
    if ($@) {
	die('Not able to get decision');
    }
    return $answer->{decision} if ( 'single' eq $kind );
    return $answer;
}


sub get_decisions {
    my ($self, $session, $point) = @_;
    my $uri = $self->baseUri->clone;
    $self->sessionId($session);
    $uri->path_segments($self->ownerCode, $self->name, "decisions" );
    # handle multidecision answer
    my $answer;
    eval {
	$answer = $self->_request(
	    $uri,
	    point=>$point,
	    );
    };
    if ($@) {
	die('Not able to get decision');
    }
    return $answer;
}



sub reward {
    my ($self, $session, $goalCode, $value) = @_;
    $value = 1 unless (defined $value);