File Coverage

blib/lib/MooX/Role/HTTP/Tiny.pm
Criterion Covered Total %
statement 18 18 100.0
branch 2 2 100.0
condition n/a
subroutine 6 6 100.0
pod n/a
total 26 26 100.0


line stmt bran cond sub pod time code
1             package MooX::Role::HTTP::Tiny;
2 2     2   10281 use Moo::Role;
  2         4  
  2         13  
3 2     2   1394 use Types::Standard qw< InstanceOf Maybe HashRef >;
  2         117974  
  2         21  
4              
5             our $VERSION = '0.94';
6              
7 2     2   5190 use URI;
  2         5169  
  2         71  
8 2     2   1514 use HTTP::Tiny;
  2         83045  
  2         402  
9              
10             =head1 NAME
11              
12             MooX::Role::HTTP::Tiny - L<HTTP::Tiny> as a role for clients that use HTTP
13              
14             =head1 SYNOPSIS
15              
16             package My::Client;
17             use Moo;
18             with qw< MooX::Role::HTTP::Tiny >;
19             use JSON qw< encode_json >;
20              
21             # implent a call to the API of a webservice
22             sub call {
23             my $self = shift;
24             my ($method, $path, $args) = @_;
25              
26             my $uri = $self->base_uri->clone;
27             $uri->path($uri->path =~ m{ / $}x ? $uri->path . $path : $path)
28             if $path;
29              
30             my @params = $args ? ({ content => encode_json($args) }) : ();
31             if (uc($method) eq 'GET') {
32             my $query = $self->www_form_urlencode($args);
33             $uri->query($query);
34             shift(@params);
35             }
36              
37             printf STDERR ">>>>> %s => %s (%s) <<<<<\n", uc($method), $uri, "@params";
38             my $response = $self->request(uc($method), $uri, @params);
39             if (not $response->{success}) {
40             die sprintf "ERROR: %s: %s\n", $response->{reason}, $response->{content};
41             }
42             return $response;
43             }
44             1;
45              
46             package My::API;
47             use Moo;
48             use Types::Standard qw< InstanceOf >;
49             has client => (
50             is => 'ro',
51             isa => InstanceOf(['My::Client']),
52             handles => [qw< call >],
53             required => 1,
54             );
55             sub fetch_stuff {
56             my $self = shift;
57             return $self->call(@_);
58             }
59             1;
60              
61             package main;
62             use My::Client;
63             use My::API;
64              
65             my $client = My::Client->new(
66             base_uri => ' https://fastapi.metacpan.org/v1/release/_search'
67             );
68             my $api = My::API->new(client => $client);
69             my $response = $api->fetch_stuff(get => '', {q => 'MooX-Role-HTTP-Tiny'});
70             print $response->{content};
71              
72             =head1 ATTRIBUTES
73              
74             =over
75              
76             =item B<base_uri> [REQUIRED] The base-uri to the webservice
77              
78             The provided uri will be I<coerced> into a L<URI> instance.
79              
80             =item B<ua> A (lazy build) instance of L<HTTP::Tiny>
81              
82             When none is provided, L<Moo> will instantiate a L<HTTP::Tiny> with the extra
83             options provided in the C<ua_options> attribute whenever it is first needed.
84              
85             The C<request> and C<www_form_urlencode> methods will be handled for the role.
86              
87             =item B<ua_options> passed through to the constructor of L<HTTP::Tiny> on lazy-build
88              
89             These options can only be passed to constructor of L<HTTP::Tiny>, so won't have
90             impact when an already instantiated C<ua> attribute is provided.
91              
92             =back
93              
94             =cut
95              
96             has base_uri => (
97             is => 'ro',
98             isa => InstanceOf([ 'URI::http', 'URI::https' ]),
99             coerce => sub { return URI->new($_[0]); },
100             required => 1,
101             );
102             has ua => (
103             is => 'lazy',
104             isa => InstanceOf(['HTTP::Tiny']),
105             handles => [qw< request www_form_urlencode >],
106             );
107             has ua_options => (
108             is => 'ro',
109             isa => Maybe([HashRef]),
110             default => undef
111             );
112              
113             =head1 REQUIRES
114              
115             The class that consumes this role needs to implement the method C<call()> as a
116             wrapper around C<HTTP::Tiny::request> to suit the remote API one is writing the
117             client for.
118              
119             =cut
120              
121             requires 'call';
122              
123             =head1 DESCRIPTION
124              
125             This role provides a basic HTTP useragent (based on L<HTTP::Tiny>) for classes
126             that want to implement a client to any webservice that uses the HTTP(S)
127             transport protocol.
128              
129             Some best known protocols are I<XMLRPC>, I<JSONRPC> and I<REST>, and can be
130             implemented through the required C<call()> method.
131              
132             =cut
133              
134             sub _build_ua {
135 3     3   16788 my $self = shift;
136             return HTTP::Tiny->new(
137             agent => join('/', __PACKAGE__, $VERSION),
138 3 100       40 (defined($self->ua_options) ? (%{ $self->ua_options }) : ()),
  1         11  
139             );
140             }
141              
142 2     2   486 use namespace::autoclean;
  2         11343  
  2         13  
143             1;
144              
145             =head1 COPYRIGHT
146              
147             E<copy> MMXXI - Abe Timmerman <abeltje@cpan.org>
148              
149             =head1 LICENSE
150              
151             This library is free software; you can redistribute it and/or modify
152             it under the same terms as Perl itself.
153              
154             This program is distributed in the hope that it will be useful,
155             but WITHOUT ANY WARRANTY; without even the implied warranty of
156             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
157              
158             =cut