File Coverage

blib/lib/GraphQL/Client/http.pm
Criterion Covered Total %
statement 82 85 96.4
branch 22 26 84.6
condition 18 30 60.0
subroutine 18 18 100.0
pod 7 7 100.0
total 147 166 88.5


line stmt bran cond sub pod time code
1             package GraphQL::Client::http;
2             # ABSTRACT: GraphQL over HTTP
3              
4 3     3   70592 use 5.010;
  3         15  
5 3     3   11 use warnings;
  3         4  
  3         52  
6 3     3   11 use strict;
  3         12  
  3         67  
7              
8 3     3   1066 use HTTP::AnyUA::Util qw(www_form_urlencode);
  3         7056  
  3         185  
9 3     3   1154 use HTTP::AnyUA;
  3         44022  
  3         69  
10 3     3   701 use namespace::clean;
  3         18709  
  3         14  
11              
12             our $VERSION = '0.605'; # VERSION
13              
14 3     3   11 sub _croak { require Carp; goto &Carp::croak }
  3         25  
15              
16             sub new {
17 9     9 1 20757 my $class = shift;
18 9 50       31 my $self = @_ % 2 == 0 ? {@_} : $_[0];
19 9         28 bless $self, $class;
20             }
21              
22             sub execute {
23 13     13 1 9148 my $self = shift;
24 13         28 my ($request, $options) = @_;
25              
26 13   100     43 my $url = delete $options->{url} || $self->url;
27 13   66     31 my $method = delete $options->{method} || $self->method;
28              
29 13 100 66     38 $request && ref($request) eq 'HASH' or _croak q{Usage: $http->execute(\%request)};
30 12 100       23 $request->{query} or _croak q{Request must have a query};
31 11 100       17 $url or _croak q{URL must be provided};
32              
33 10         23 my $data = {%$request};
34              
35 10 100 66     29 if ($method eq 'GET' || $method eq 'HEAD') {
36 2 50       5 $data->{variables} = $self->json->encode($data->{variables}) if $data->{variables};
37 2         6 my $params = www_form_urlencode($data);
38 2 100       110 my $sep = $url =~ /^[^#]+\?/ ? '&' : '?';
39 2 50       8 $url =~ s/#/${sep}${params}#/ or $url .= "${sep}${params}";
40             }
41             else {
42 8         13 my $encoded_data = $self->json->encode($data);
43 8         61 $options->{content} = $encoded_data;
44 8         17 $options->{headers}{'content-length'} = length $encoded_data;
45 8         13 $options->{headers}{'content-type'} = 'application/json;charset=UTF-8';
46             }
47              
48 10         15 return $self->_handle_response($self->any_ua->request($method, $url, $options));
49             }
50              
51             sub _handle_response {
52 10     10   375 my $self = shift;
53 10         15 my ($resp) = @_;
54              
55 10 100       11 if (eval { $resp->isa('Future') }) {
  10         53  
56             return $resp->followed_by(sub {
57 3     3   144 my $f = shift;
58              
59 3 100       6 if (my ($exception, $category, @other) = $f->failure) {
60 1 50       10 if (ref $exception eq 'HASH') {
61 1         2 my $resp = $exception;
62 1         2 return Future->done($self->_handle_error($resp));
63             }
64              
65 0         0 return Future->done({
66             error => $exception,
67             response => undef,
68             details => {
69             exception_details => [$category, @other],
70             },
71             });
72             }
73              
74 2         15 my $resp = $f->get;
75 2         24 return Future->done($self->_handle_success($resp));
76 3         15 });
77             }
78             else {
79 7 100       19 return $self->_handle_error($resp) if !$resp->{success};
80 3         7 return $self->_handle_success($resp);
81             }
82             }
83              
84             sub _handle_error {
85 5     5   5 my $self = shift;
86 5         7 my ($resp) = @_;
87              
88 5         6 my $data = eval { $self->json->decode($resp->{content}) };
  5         7  
89 5   50     30 my $content = $resp->{content} // 'No content';
90 5   50     11 my $reason = $resp->{reason} // '';
91 5         12 my $message = "HTTP transport returned $resp->{status} ($reason): $content";
92              
93 5         6 chomp $message;
94              
95             return {
96 5         25 error => $message,
97             response => $data,
98             details => {
99             http_response => $resp,
100             },
101             };
102             }
103              
104             sub _handle_success {
105 5     5   5 my $self = shift;
106 5         7 my ($resp) = @_;
107              
108 5         7 my $data = eval { $self->json->decode($resp->{content}) };
  5         7  
109 5 100       12 if (my $exception = $@) {
110             return {
111 1         8 error => "HTTP transport failed to decode response: $exception",
112             response => undef,
113             details => {
114             http_response => $resp,
115             },
116             };
117             }
118              
119             return {
120 4         18 response => $data,
121             details => {
122             http_response => $resp,
123             },
124             };
125             }
126              
127             sub ua {
128 5     5 1 6 my $self = shift;
129 5   33     20 $self->{ua} //= do {
130 0         0 require HTTP::Tiny;
131             HTTP::Tiny->new(
132 0   0     0 agent => $ENV{GRAPHQL_CLIENT_HTTP_USER_AGENT} // "perl-graphql-client/$VERSION",
133             );
134             };
135             }
136              
137             sub any_ua {
138 15     15 1 25 my $self = shift;
139 15   66     45 $self->{any_ua} //= HTTP::AnyUA->new(ua => $self->ua);
140             }
141              
142             sub url {
143 14     14 1 17 my $self = shift;
144 14         31 $self->{url};
145             }
146              
147             sub method {
148 13     13 1 19 my $self = shift;
149 13   100     44 $self->{method} // 'POST';
150             }
151              
152             sub json {
153 18     18 1 24 my $self = shift;
154 18   66     126 $self->{json} //= do {
155 4         16 require JSON::MaybeXS;
156 4         14 JSON::MaybeXS->new(utf8 => 1);
157             };
158             }
159              
160             1;
161              
162             __END__