File Coverage

blib/lib/AI/CleverbotIO.pm
Criterion Covered Total %
statement 21 54 38.8
branch 0 18 0.0
condition 0 8 0.0
subroutine 7 13 53.8
pod 4 4 100.0
total 32 97 32.9


line stmt bran cond sub pod time code
1             package AI::CleverbotIO;
2 2     2   25659 use strict;
  2         3  
  2         48  
3 2     2   6 use warnings;
  2         2  
  2         69  
4             { our $VERSION = '0.002'; }
5              
6 2     2   946 use Moo;
  2         19784  
  2         8  
7 2     2   2837 use Ouch;
  2         2951  
  2         94  
8 2     2   438 use Log::Any ();
  2         5443  
  2         28  
9 2     2   1008 use Data::Dumper;
  2         8896  
  2         97  
10 2     2   614 use JSON::PP qw< decode_json >;
  2         9308  
  2         893  
11              
12             has endpoints => (
13             is => 'ro',
14             default => sub {
15             return {
16             ask => 'https://cleverbot.io/1.0/ask',
17             create => 'https://cleverbot.io/1.0/create',
18             };
19             },
20             );
21              
22             has key => (
23             is => 'ro',
24             required => 1,
25             );
26              
27             has logger => (
28             is => 'ro',
29             lazy => 1,
30             builder => 'BUILD_logger',
31             );
32              
33             has nick => (
34             is => 'rw',
35             lazy => 1,
36             predicate => 1,
37             );
38              
39             has user => (
40             is => 'ro',
41             required => 1,
42             );
43              
44             has ua => (
45             is => 'ro',
46             lazy => 1,
47             builder => 'BUILD_ua',
48             );
49              
50             sub BUILD_logger {
51 0     0 1   return Log::Any->get_logger;
52             }
53              
54             sub BUILD_ua {
55 0     0 1   my $self = shift;
56 0           require HTTP::Tiny;
57 0           return HTTP::Tiny->new;
58             }
59              
60             sub ask {
61 0     0 1   my ($self, $question) = @_;
62 0           my %ps = (
63             key => $self->key,
64             text => $question,
65             user => $self->user,
66             );
67 0 0         $ps{nick} = $self->nick if $self->has_nick;
68             return $self->_parse_response(
69 0           $self->ua->post_form($self->endpoints->{ask}, \%ps));
70             }
71              
72             sub create {
73 0     0 1   my $self = shift;
74 0 0         $self->nick(shift) if @_;
75              
76             # build request parameters
77 0           my %ps = (
78             key => $self->key,
79             user => $self->user,
80             );
81 0 0 0       $ps{nick} = $self->nick if $self->has_nick && length $self->nick;
82              
83             my $data =
84             $self->_parse_response(
85 0           $self->ua->post_form($self->endpoints->{create}, \%ps));
86              
87 0 0         $self->nick($data->{nick}) if exists($data->{nick});
88              
89 0           return $data;
90             }
91              
92             sub _parse_response {
93 0     0     my ($self, $response) = @_;
94              
95             {
96 0           local $Data::Dumper::Indent = 1;
  0            
97 0           $self->logger->debug('got response: ' . Dumper($response));
98             }
99              
100 0 0         ouch 500, 'no response (possible bug in HTTP::Tiny though?)'
101             unless ref($response) eq 'HASH';
102              
103 0           my $status = $response->{status};
104             ouch $status, $response->{reason}
105 0 0 0       if ($status != 200) && ($status != 400);
106              
107 0           my $data = __decode_content($response);
108 0 0         return $data if $response->{success};
109 0           ouch 400, $data->{status};
110             } ## end sub _parse_response
111              
112             sub __decode_content {
113 0     0     my $response = shift;
114 0           my $encoded = $response->{content};
115 0 0         if (!$encoded) {
116 0   0       my $url = $response->{url} // '*unknown url, check HTTP::Tiny*';
117 0           ouch 500, "response status $response->{status}, nothing from $url)";
118             }
119 0 0         my $decoded = eval { decode_json($encoded) }
  0            
120             or ouch 500, "response status $response->{status}, exception: $@";
121 0           return $decoded;
122             } ## end sub __decode_content
123              
124             1;