File Coverage

blib/lib/Net/Async/Consul.pm
Criterion Covered Total %
statement 39 49 79.5
branch 1 2 50.0
condition n/a
subroutine 12 19 63.1
pod 0 9 0.0
total 52 79 65.8


line stmt bran cond sub pod time code
1             package Net::Async::Consul;
2             $Net::Async::Consul::VERSION = '0.002';
3             # ABSTRACT: Make async calls to Consul via IO::Async
4              
5 4     4   750059 use warnings;
  4         38  
  4         106  
6 4     4   19 use strict;
  4         6  
  4         94  
7              
8 4     4   1631 use Consul 0.016;
  4         974799  
  4         170  
9 4     4   2250 use Net::Async::HTTP;
  4         309411  
  4         154  
10 4     4   34 use HTTP::Request;
  4         9  
  4         67  
11 4     4   22 use HTTP::Headers;
  4         7  
  4         82  
12 4     4   19 use Hash::MultiValue;
  4         9  
  4         99  
13 4     4   16 use List::Util 1.29 qw(pairmap);
  4         57  
  4         194  
14 4     4   28 use Carp qw(croak);
  4         10  
  4         1945  
15              
16             sub new {
17 2     2 0 11 my ($class, %args) = @_;
18              
19 2         7 my $loop = delete $args{loop};
20 2 50       8 croak "missing required param: loop" unless $loop;
21 2         30 my $http = Net::Async::HTTP->new(
22             max_connections_per_host => 4,
23             max_in_flight => 4,
24             );
25 2         207 $loop->add($http);
26              
27             Consul->new(%args,
28             request_cb => sub {
29 2     2   14430 my ($self, $req) = @_;
30             $http->do_request(
31             request => HTTP::Request->new(
32             $req->method,
33             $req->url,
34 2         29 HTTP::Headers->new(%{$req->headers->as_hashref}),
35             $req->content,
36             ),
37             timeout => $self->timeout,
38             on_response => sub {
39 0         0 my ($r) = @_;
40             $req->callback->(Consul::Response->new(
41             status => $r->code,
42             reason => $r->message,,
43 0         0 headers => Hash::MultiValue->new(pairmap { (lc($a) => $b) } $r->headers->flatten),
  0         0  
44             content => $r->content,
45             request => $req,
46             ));
47             },
48             on_error => sub {
49 2         3402 $req->callback->(Consul::Response->new(
50             status => 599,
51             reason => "internal error: @_",
52             request => $req,
53             ));
54             }
55 2         21 );
56 2         36124 return;
57             },
58 2         175 );
59             }
60              
61 0     0 0 0 sub acl { shift->new(@_)->acl }
62 2     2 0 8947 sub agent { shift->new(@_)->agent }
63 0     0 0   sub catalog { shift->new(@_)->catalog }
64 0     0 0   sub event { shift->new(@_)->event }
65 0     0 0   sub health { shift->new(@_)->health }
66 0     0 0   sub kv { shift->new(@_)->kv }
67 0     0 0   sub session { shift->new(@_)->session }
68 0     0 0   sub status { shift->new(@_)->status }
69              
70             1;
71              
72             =pod
73              
74             =encoding UTF-8
75              
76             =for markdown [![Build Status](https://secure.travis-ci.org/robn/Net-Async-Consul.png)](http://travis-ci.org/robn/Net-Async-Consul)
77              
78             =head1 NAME
79              
80             Net::Async::Consul - Make async calls to Consul via IO::Async
81              
82             =head1 SYNOPSIS
83              
84             use IO::Async::Loop;
85             use Net::Async::Consul;
86              
87             my $loop = IO::Async::Loop->new;
88            
89             my $kv = Net::Async::Consul->kv(loop => $loop);
90              
91             # do some blocking op to discover the current index
92             $kv->get("mykey", cb => sub {
93             my ($v, $meta) = @_;
94            
95             # now set up a long-poll to watch a key we're interested in
96             $kv->get("mykey", index => $meta->index, cb => sub {
97             my ($v, $meta) = @_;
98             say "mykey changed to ".$v->value;
99             $loop->stop;
100             });
101             });
102            
103             # make the change
104             $kv->put("mykey" => "newval");
105            
106             $loop->run;
107              
108             =head1 DESCRIPTION
109              
110             Net::Async::Consul is a thin wrapper around L to connect it to
111             L for asynchronous operation.
112              
113             It takes the same arguments and methods as L itself, so see the
114             documentation for that module for details. The important difference is that you
115             must pass the C option with the loop object to API methods, the C
116             option to the endpoint methods to enable their asynchronous mode.
117              
118             There's also a C argument. If you pass in a coderef for this
119             argument, it will be called with a single string arg whenever something goes
120             wrong internally (usually a HTTP failure). Use it to safely log or cleanup
121             after the error.
122              
123             =head1 SUPPORT
124              
125             =head2 Bugs / Feature Requests
126              
127             Please report any bugs or feature requests through the issue tracker
128             at L.
129             You will be notified automatically of any progress on your issue.
130              
131             =head2 Source Code
132              
133             This is open source software. The code repository is available for
134             public review and contribution under the terms of the license.
135              
136             L
137              
138             git clone https://github.com/robn/Net-Async-Consul.git
139              
140             =head1 AUTHORS
141              
142             =over 4
143              
144             =item *
145              
146             Rob N ★
147              
148             =back
149              
150             =head1 COPYRIGHT AND LICENSE
151              
152             This software is copyright (c) 2018 by Rob N ★.
153              
154             This is free software; you can redistribute it and/or modify it under
155             the same terms as the Perl 5 programming language system itself.
156              
157             =cut