File Coverage

blib/lib/Etcd3/Role/Actions.pm
Criterion Covered Total %
statement 33 77 42.8
branch 0 12 0.0
condition n/a
subroutine 11 19 57.8
pod 3 3 100.0
total 47 111 42.3


line stmt bran cond sub pod time code
1 5     5   38241 use utf8;
  5         12  
  5         36  
2             package Etcd3::Role::Actions;
3              
4 5     5   193 use strict;
  5         11  
  5         99  
5 5     5   22 use warnings;
  5         9  
  5         111  
6              
7 5     5   21 use Moo::Role;
  5         10  
  5         27  
8 5     5   3515 use AE;
  5         24200  
  5         139  
9 5     5   34 use JSON;
  5         13  
  5         42  
10 5     5   645 use MIME::Base64;
  5         13  
  5         303  
11 5     5   33 use Types::Standard qw(InstanceOf);
  5         10  
  5         90  
12 5     5   5928 use AnyEvent::HTTP;
  5         121578  
  5         385  
13 5     5   2910 use Data::Dumper;
  5         26809  
  5         304  
14              
15 5     5   38 use namespace::clean;
  5         11  
  5         44  
16              
17             =encoding utf8
18              
19             =head1 NAME
20              
21             Etcd3::Role::Actions
22              
23             =cut
24              
25             our $VERSION = '0.007';
26              
27             has etcd => (
28             is => 'ro',
29             isa => InstanceOf ['Etcd3'],
30             );
31              
32             =head2 json_args
33              
34             arguments that will be sent to the api
35              
36             =cut
37              
38             has json_args => ( is => 'lazy', );
39              
40             sub _build_json_args {
41 0     0     my ($self) = @_;
42 0           my $args;
43 0           for my $key ( keys %{$self} ) {
  0            
44 0 0         unless ( $key =~ /(?:etcd|cb|cv|json_args|endpoint)$/ ) {
45 0           $args->{$key} = $self->{$key};
46             }
47             }
48 0           return to_json($args);
49             }
50              
51             =head2 cb
52              
53             AnyEvent callback must be a CodeRef
54              
55             =cut
56              
57             has cb => (
58             is => 'ro',
59             isa => sub {
60             die "$_[0] is not a CodeRef!" if ( $_[0] && ref($_[0]) ne 'CODE')
61             },
62             );
63              
64             =head2 cv
65              
66             =cut
67              
68             has cv => (
69             is => 'ro',
70             );
71              
72             =head2 init
73              
74             =cut
75              
76             sub init {
77 0     0 1   my ($self) = @_;
78 0           my $init = $self->json_args;
79 0 0         $init or return;
80 0           return $self;
81             }
82              
83             =head2 headers
84              
85             =cut
86              
87             has headers => ( is => 'ro' );
88              
89             =head2 response
90              
91             =cut
92              
93             has response => ( is => 'ro' );
94              
95             =head2 request
96              
97             =cut
98              
99             has request => ( is => 'lazy', );
100              
101             sub _build_request {
102 0     0     my ($self) = @_;
103 0           $self->init;
104 0           my $cb = $self->cb;
105 0 0         my $cv = $self->cv ? $self->cv : AE::cv;
106 0           $cv->begin;
107             http_request(
108             'POST',
109             $self->etcd->api_path . $self->{endpoint},
110             headers => $self->headers,
111             body => $self->json_args,
112             on_header => sub {
113 0     0     my($headers) = @_;
114 0           $self->{response}{headers} = $headers;
115             },
116             on_body => sub {
117 0     0     my ($data, $hdr) = @_;
118 0           $self->{response}{content} = $data;
119 0 0         $cb->($data, $hdr) if $cb;
120 0           $cv->end;
121 0           1
122             },
123             sub {
124 0     0     my (undef, $hdr) = @_;
125             #print STDERR Dumper($hdr);
126 0           my $status = $hdr->{Status};
127 0 0         $self->{response}{success} = 1 if $status == 200;
128 0           $cv->end;
129             }
130 0           );
131 0           $cv->recv;
132 0           return $self;
133             }
134              
135             =head2 get_value
136              
137             returns single decoded value or the first.
138              
139             =cut
140              
141             sub get_value {
142 0     0 1   my ($self) = @_;
143 0           my $response = $self->response;
144 0           my $content = from_json( $response->{content} );
145             #print STDERR Dumper($content);
146 0           my $value = $content->{kvs}->[0]->{value};
147 0 0         $value or return;
148 0           return decode_base64($value);
149             }
150              
151             =head2 all
152              
153             returns list containing for example:
154              
155             {
156             'mod_revision' => '3',
157             'version' => '1',
158             'value' => 'bar',
159             'create_revision' => '3',
160             'key' => 'foo0'
161             }
162              
163             where key and value have been decoded for your pleasure.
164              
165             =cut
166              
167             sub all {
168 0     0 1   my ($self) = @_;
169 0           my $response = $self->response;
170 0           my $content = from_json( $response->{content} );
171 0           my $kvs = $content->{kvs};
172 0           for my $row (@$kvs) {
173 0           $row->{value} = decode_base64( $row->{value} );
174 0           $row->{key} = decode_base64( $row->{key} );
175             }
176 0           return $kvs;
177             }
178              
179             1;