File Coverage

blib/lib/Role/REST/Client.pm
Criterion Covered Total %
statement 99 108 91.6
branch 17 24 70.8
condition 10 21 47.6
subroutine 30 35 85.7
pod 1 10 10.0
total 157 198 79.2


line stmt bran cond sub pod time code
1             package Role::REST::Client;
2             $Role::REST::Client::VERSION = '0.22';
3 3     3   486115 use Moo::Role;
  3         14468  
  3         19  
4 3     3   5336 use MooX::HandlesVia;
  3         3949  
  3         16  
5 3     3   1610 use Types::Standard qw(HashRef Str Int Enum HasMethods);
  3         178303  
  3         33  
6              
7 3     3   6153 use HTTP::Tiny;
  3         81365  
  3         114  
8 3     3   1209 use URI::Escape::XS 'uri_escape';
  3         5550  
  3         180  
9 3     3   397 use Try::Tiny;
  3         935  
  3         170  
10 3     3   21 use Carp qw(confess);
  3         9  
  3         127  
11 3     3   442 use HTTP::Response;
  3         13016  
  3         74  
12 3     3   16 use HTTP::Status 'status_message';
  3         5  
  3         297  
13 3     3   21 use HTTP::Headers;
  3         5  
  3         58  
14              
15 3     3   1154 use Role::REST::Client::Serializer;
  3         10  
  3         92  
16 3     3   1030 use Role::REST::Client::Response;
  3         11  
  3         3527  
17              
18             has 'server' => (
19             isa => Str,
20             is => 'rw',
21             default => '',
22             );
23              
24             has 'type' => (
25             isa => Enum[qw{application/json application/xml application/yaml application/x-www-form-urlencoded}],
26             is => 'rw',
27             default => sub { 'application/json' },
28             );
29              
30             has clientattrs => (
31             isa => HashRef,
32             is => 'ro',
33             default => sub {return {} }
34             );
35              
36             has user_agent => (
37             isa => HasMethods['request'],
38             is => 'ro',
39             lazy => 1,
40             builder => '_build_user_agent',
41             );
42              
43             sub _build_user_agent {
44 2     2   43 my $self = shift;
45 2         1299 require HTTP::Thin;
46 2         6212 return HTTP::Thin->new(%{$self->clientattrs});
  2         52  
47             }
48              
49             has persistent_headers => (
50             is => 'rw',
51             # isa => HashRef[Str],
52             default => sub { {} },
53             handles_via => 'Hash',
54             handles => {
55             set_persistent_header => 'set',
56             get_persistent_header => 'get',
57             has_no_persistent_headers => 'is_empty',
58             clear_persistent_headers => 'clear',
59             },
60             );
61              
62             has _httpheaders => (
63             is => 'rw',
64             isa => HashRef[Str],
65             init_arg => 'httpheaders',
66             default => sub { {} },
67             handles_via => 'Hash',
68             handles => {
69             set_header => 'set',
70             get_header => 'get',
71             exist_header => 'exists',
72             has_no_headers => 'is_empty',
73             clear_headers => 'clear',
74             reset_headers => 'clear',
75             },
76             );
77              
78             sub httpheaders {
79 20     20 1 10167 my $self = shift;
80 20         39 return { %{$self->persistent_headers}, %{$self->_httpheaders} };
  20         99  
  20         389  
81             }
82              
83             sub clear_all_headers {
84 1     1 0 1201 my $self = shift;
85 1         37 $self->clear_headers;
86 1         111 $self->clear_persistent_headers;
87 1         103 return {};
88             }
89              
90             has serializer_class => (
91             isa => Str,
92             is => 'ro',
93             default => sub { 'Role::REST::Client::Serializer' },
94             );
95              
96             has serializer_options => (
97             isa => HashRef,
98             is => 'ro',
99             default => sub { return {} },
100             );
101              
102 11     11   298 sub _rest_response_class { 'Role::REST::Client::Response' }
103              
104             # If the response is a hashref, we expect it to be in the format returned by
105             # HTTP::Tiny->request() and convert it to an HTTP::Response object. Otherwise,
106             # pass the response through unmodified.
107             sub _handle_response {
108 12     12   38799 my ( $self, $res ) = @_;
109 12 50       53 if ( ref $res eq 'HASH' ) {
110 0         0 my $code = $res->{'status'};
111             return HTTP::Response->new(
112             $code,
113             $res->{'reason'} || status_message($code),
114 0         0 HTTP::Headers->new(%{$res->{'headers'}}),
115 0   0     0 $res->{'content'},
116             );
117             } else {
118 12         37 return $res;
119             }
120             }
121              
122             sub _new_rest_response {
123 12     12   444 my ($self, @args) = @_;
124 12         51 return $self->_rest_response_class->new(@args);
125             }
126              
127             sub new_serializer {
128 1     1 0 8 my ($self, @args) = @_;
129 1         3 my %args = (%{ $self->serializer_options }, @args);
  1         13  
130 1         23 $self->serializer_class->new(%args);
131             }
132              
133             sub _serializer {
134 3     3   10 my ($self, $type) = @_;
135 3   33     26 $type ||= $self->type;
136 3         11 $type =~ s/;\s*?charset=.+$//i; #remove stuff like ;charset=utf8
137             try {
138 3   66 3   329 $self->{serializer}{$type} ||= $self->new_serializer(type => $type);
139             }
140             catch {
141             # Deal with real life content types like "text/xml;charset=ISO-8859-1"
142 0     0   0 warn "No serializer available for " . $type . " content. Trying default " . $self->type;
143 0         0 $self->{serializer}{$type} = $self->new_serializer(type => $self->type);
144 3         107 };
145 3         3303 return $self->{serializer}{$type};
146             }
147              
148             sub do_request {
149 12     12 0 50 my ($self, $method, $uri, $opts) = @_;
150 12         221 return $self->user_agent->request($method, $uri, $opts);
151             }
152              
153             sub _call {
154 12     12   37 my ($self, $method, $endpoint, $data, $args) = @_;
155 12         290 my $uri = $self->server . $endpoint;
156             # If no data, just call endpoint (or uri if GET w/parameters)
157             # If data is a scalar, call endpoint with data as content (POST w/parameters)
158             # Otherwise, encode data
159 12         314 $self->set_header('content-type', $self->type);
160 12         1831 my %options = (headers => $self->httpheaders);
161 12 100       166 if ( defined $data ) {
162 4 50       14 $options{content} = ref $data ? $self->_serializer->serialize($data) : $data;
163 4         12 $options{'headers'}{'content-length'} = length($options{'content'});
164             }
165 12         57 my $res = $self->_handle_response( $self->do_request($method, $uri, \%options) );
166              
167 12 50       364 $self->reset_headers unless $args->{preserve_headers};
168              
169             my $use_serializer = exists $args->{deserializer}
170 12 100       788 ? defined $args->{deserializer} ? 1 : 0
    100          
171             : $res->header('Content-Type') !~ m{(?:text/(?:plain|html)|application/octet-stream)};
172              
173             my $deserializer_cb = sub {
174             # Try to find a serializer for the result content
175 3   66 3   498 my $content_type = $args->{deserializer} || $res->header('Content-Type');
176 3         56 my $deserializer = $self->_serializer($content_type);
177             # Try to deserialize
178 3         14 my $content = $res->decoded_content;
179 3 50 33     1076 $content = $deserializer->deserialize($content) if $deserializer && $content;
180 3   50     40 $content ||= {};
181 12         630 };
182              
183             return $self->_new_rest_response(
184             code => $res->code,
185             response => $res,
186             data => $use_serializer
187 3     3   5814 ? $deserializer_cb : sub { $res->decoded_content },
188 12 100       55 $res->is_error ? ( error => $res->message) : (),
    100          
189             );
190             }
191              
192             sub _urlencode_data {
193 5     5   14 my ($self, $data) = @_;
194 5         13 return join '&', map { uri_escape($_) . '=' . uri_escape($data->{$_})} keys %$data;
  6         56  
195             }
196              
197             sub _request_with_query {
198 8     8   36 my ($self, $method, $endpoint, $data, $args) = @_;
199 8         21 my $uri = $endpoint;
200 8 50 100     48 if ($data && scalar keys %$data) {
201 1         3 $uri .= '?' . $self->_urlencode_data($data);
202             }
203 8         61 return $self->_call($method, $uri, undef, $args);
204             }
205              
206 8     8 0 11808 sub get { return shift->_request_with_query('GET', @_) }
207              
208 0     0 0 0 sub head { return shift->_request_with_query('HEAD', @_) }
209              
210             sub _request_with_body {
211 4     4   12 my ($self, $method, $endpoint, $data, $args) = @_;
212 4         9 my $content = $data;
213 4 50       89 if ( $self->type =~ /urlencoded/ ) {
214 4 50 50     74 $content = ( $data && scalar keys %$data ) ? $self->_urlencode_data($data) : q{};
215             }
216 4         119 return $self->_call($method, $endpoint, $content, $args);
217             }
218              
219 4     4 0 3063 sub post { return shift->_request_with_body('POST', @_) }
220              
221 0     0 0   sub put { return shift->_request_with_body('PUT', @_) }
222              
223 0     0 0   sub options { return shift->_request_with_body('OPTIONS', @_) }
224              
225 0     0 0   sub delete { return shift->_request_with_query('DELETE', @_) }
226              
227             1;
228              
229             =pod
230              
231             =encoding UTF-8
232              
233             =head1 NAME
234              
235             Role::REST::Client - REST Client Role
236              
237             =head1 VERSION
238              
239             version 0.22
240              
241             =head1 SYNOPSIS
242              
243             {
244             package RESTExample;
245              
246             use Moose;
247             with 'Role::REST::Client';
248              
249             sub bar {
250             my ($self) = @_;
251             my $res = $self->post('/foo/bar/baz', {foo => 'bar'});
252             my $code = $res->code;
253             my $data = $res->data;
254             return $data if $code == 200;
255             }
256              
257             }
258              
259             my $foo = RESTExample->new(
260             server => 'http://localhost:3000',
261             type => 'application/json',
262             clientattrs => {timeout => 5},
263             );
264              
265             $foo->bar;
266              
267             # controller
268             sub foo : Local {
269             my ($self, $c) = @_;
270             my $res = $c->model('MyData')->post('/foo/bar/baz', {foo => 'bar'});
271             my $code = $res->code;
272             my $data = $res->data;
273             ...
274             }
275              
276             =head1 DESCRIPTION
277              
278             This REST Client role makes REST connectivity easy.
279              
280             Role::REST::Client will handle encoding and decoding when using the HTTP verbs.
281              
282             GET
283             HEAD
284             PUT
285             POST
286             DELETE
287             OPTIONS
288              
289             Currently Role::REST::Client supports these encodings
290              
291             application/json
292             application/x-www-form-urlencoded
293             application/xml
294             application/yaml
295              
296             x-www-form-urlencoded only works for GET and POST, and only for encoding, not decoding.
297              
298             Responses which claim to not be serialised data (eg C<text/plain>,
299             C<application/octet-stream>) will by default not be serialised. When the
300             response is none of these, and it is impossible to determine what encoding is
301             used, the content will be treated as JSON by default.
302              
303             =head1 NAME
304              
305             Role::REST::Client - REST Client Role
306              
307             =head1 METHODS
308              
309             =head2 methods
310              
311             Role::REST::Client implements the standard HTTP 1.1 verbs as methods
312              
313             These methods can NOT have a request body
314              
315             get
316             head
317              
318             These methods can take a request body.
319              
320             post
321             put
322             delete
323             options
324              
325             All methods take these parameters
326              
327             url - The REST service
328             data - The data structure (hashref, arrayref) to send. The data will be encoded
329             according to the value of the I<type> attribute.
330             args - hashref with arguments to augment the way the call is handled.
331              
332             args - the optional argument parameter can have these entries
333              
334             deserializer - if you KNOW that the content-type of the response is incorrect,
335             you can supply the correct content type, like
336              
337             my $res = $self->post('/foo/bar/baz', {foo => 'bar'}, {deserializer => 'application/yaml'});
338              
339             Alternatively, if you KNOW that the response is not serial data, you can
340             disable deserialization by setting this to undef.
341              
342             preserve_headers - set this to true if you want to keep the headers between calls
343              
344             All methods return a response object dictated by _rest_response_class. Set to L<Role::REST::Client::Response> by default.
345              
346             =head1 ATTRIBUTES
347              
348             =head2 user_agent
349              
350             sub _build_user_agent { HTTP::Thin->new }
351              
352             A User Agent object which has a C<< ->request >> method suitably compatible with L<HTTP::Tiny>. It should accept arguments like this: C<< $ua->request($method, $uri, $opts) >>, and needs to return a hashref as HTTP::Tiny does, or an L<HTTP::Response> object. To set your own default, use a C<_build_user_agent> method.
353              
354             =head2 server
355              
356             URL of the REST server.
357              
358             e.g. 'http://localhost:3000'
359              
360             =head2 type
361              
362             MIME Content-Type header,
363              
364             e.g. application/json
365              
366             =head2 persistent_headers
367              
368             $self->set_persistent_header('Header' => 'foo', ... );
369             $self->get_persistent_header('Header-Name');
370             $self->has_no_persistent_headers;
371             $self->clear_persistent_headers;
372              
373             A hashref containing headers you want to use for all requests. Use the methods
374             described above to manipulate it.
375              
376             To set your own defaults, override the default or call C<set_persistent_header()> in your
377             C<BUILD> method.
378              
379             has '+persistent_headers' => (
380             default => sub { ... },
381             );
382              
383             =head2 httpheaders
384              
385             $self->set_header('Header' => 'foo', ... );
386             $self->get_header('Header-Name');
387             $self->has_no_headers;
388             $self->clear_headers;
389              
390             You can set any http header you like with set_header, e.g.
391             $self->set_header($key, $value) but the content-type header will be overridden.
392              
393             http_headers will be reset after each request, unless there's a reserve_headers
394             argument, but it's a hack. The recommended way to keep headers across requests
395             is to store them in the persistent_headers.
396              
397             $self->httpheaders will return the combined hashref of persistent_headers and
398             what's been added with set_header.
399              
400             For historical reasons, the two methods clear_headers and reset_headers are
401             equal. Both will clear the headers for the current request, but NOT the
402             persistent headers.
403              
404             To clear ALL headers, use
405              
406             $self->clear_all_headers;
407              
408             =head2 clientattrs
409              
410             Attributes to feed the user agent object (which defaults to L<HTTP::Thin>)
411              
412             e.g. {timeout => 10}
413              
414             =head2 serializer_class
415              
416             You can override the serializer class and use your own. Default is 'Role::REST::Client::Serializer'
417              
418             =head2 serializer_options
419              
420             Options for the serializer instantiation.
421              
422             =head1 CONTRIBUTORS
423              
424             Breno G. de Oliveira, <garu@cpan.org>
425              
426             Mark Stosberg, <mark@stosberg.com>
427              
428             Matt Phillips, (cpan:MATTP) <mattp@cpan.org>
429              
430             Wallace Reis, <wallace@reis.me>
431              
432             =head1 BUGS
433              
434             Please report any bugs or feature requests to bug-role-rest-client at rt.cpan.org, or through the
435             web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Role-REST-Client.
436              
437             =head1 AUTHOR
438              
439             Kaare Rasmussen <kaare at cpan dot org>
440              
441             =head1 COPYRIGHT AND LICENSE
442              
443             This software is copyright (c) 2017 by Kaare Rasmussen.
444              
445             This is free software; you can redistribute it and/or modify it under
446             the same terms as the Perl 5 programming language system itself.
447              
448             =cut
449              
450             __END__
451              
452             # ABSTRACT: REST Client Role
453