File Coverage

blib/lib/Zabbix2/API.pm
Criterion Covered Total %
statement 35 119 29.4
branch 0 34 0.0
condition n/a
subroutine 12 21 57.1
pod 7 7 100.0
total 54 181 29.8


line stmt bran cond sub pod time code
1             package Zabbix2::API;
2            
3 14     14   1326299 use strict;
  14         169  
  14         420  
4 14     14   84 use warnings;
  14         26  
  14         347  
5 14     14   285 use 5.010;
  14         55  
6 14     14   76 use Carp;
  14         28  
  14         782  
7            
8 14     14   7861 use Moo;
  14         163528  
  14         126  
9            
10 14     14   21370 use Scalar::Util qw/blessed/;
  14         32  
  14         732  
11 14     14   6629 use Module::Loaded;
  14         9662  
  14         815  
12 14     14   7355 use Module::Load;
  14         16781  
  14         93  
13 14     14   8215 use Params::Validate qw/validate :types/;
  14         88778  
  14         2612  
14 14     14   9192 use JSON;
  14         164797  
  14         113  
15 14     14   11002 use LWP::UserAgent;
  14         582751  
  14         584  
16 14     14   7038 use Log::Any;
  14         120392  
  14         93  
17            
18             our $VERSION = '0.014';
19            
20             has 'server' => (is => 'ro',
21             required => 1);
22             has 'ua' => (is => 'ro',
23             lazy => 1,
24             builder => '_build_ua');
25             has 'cookie' => (is => 'ro',
26             predicate => 1,
27             clearer => '_clear_cookie',
28             writer => '_set_cookie');
29             has 'user' => (is => 'ro',
30             init_arg => undef,
31             clearer => '_clear_user',
32             writer => '_set_user');
33             # equivalent to the old "lazy" parameter
34             has 'pull_after_push_mode' => (is => 'rw',
35             default => 1);
36            
37             state $global_id = int(rand(10000));
38            
39             sub _build_ua {
40 0     0     my $self = shift;
41 0           return LWP::UserAgent->new(agent => 'Zabbix API client (libwww-perl)');
42             }
43            
44             sub useragent {
45 0     0 1   return shift->ua;
46             }
47            
48             sub api_version {
49 0     0 1   my $self = shift;
50             # can't use _raw_query here because the server refuses the request
51             # if an auth parameter is present -- wtf zabbix
52 0           my $response = eval { $self->ua->post($self->server,
  0            
53             'Content-Type' => 'application/json-rpc',
54             Content => encode_json({
55             jsonrpc => '2.0',
56             id => $global_id++,
57             method => 'apiinfo.version',
58             })) };
59            
60 0 0         if (my $error = $@) {
61             # no good
62 0           croak sprintf('Could not request API version info: %s (%s, %s)',
63             $error, $response->code, $response->message);
64             }
65            
66 0           my $decoded = eval { decode_json($response->decoded_content) };
  0            
67            
68 0 0         if (my $error = $@) {
69             # no good either
70 0           croak sprintf('Could not request API version info: %s (%s, %s)',
71             $error, $response->code, $response->message);
72             }
73            
74 0 0         if ($decoded->{error}) {
75 0           croak 'Could not request API version info: '.$decoded->{error}->{data};
76             }
77            
78 0           return $decoded->{result};
79             }
80            
81             sub login {
82 0     0 1   my $self = shift;
83 0           my %args = validate(@_, { user => 1,
84             password => 1 });
85 0           $self->_clear_cookie;
86 0           $self->_clear_user;
87            
88 0           my $response = $self->_raw_query(method => 'user.login',
89             params => \%args);
90 0           my $decoded = eval { decode_json($response->decoded_content) };
  0            
91            
92 0 0         if (my $error = $@) {
93             # probably could not connect at all
94 0           croak sprintf('Could not connect: %s (%s, %s)',
95             $error, $response->code, $response->message);
96             }
97            
98 0 0         if ($decoded->{error}) {
99 0           croak 'Could not log in: '.$decoded->{error}->{data};
100             }
101            
102 0           $self->_set_cookie($decoded->{result});
103 0           $self->_set_user($args{user});
104            
105 0           return $self;
106             }
107            
108             sub logout {
109            
110 0     0 1   my $self = shift;
111 0           my $response = $self->_raw_query(method => 'user.logout');
112 0           my $decoded = eval { decode_json($response->decoded_content) };
  0            
113            
114 0 0         if (my $error = $@) {
115             # probably could not connect at all
116 0           croak sprintf('Could not log out: %s (%s, %s)',
117             $error, $response->code, $response->message);
118             }
119            
120 0 0         if ($decoded->{error}) {
121 0           croak 'Could not log out: '.$decoded->{error}->{data};
122             }
123            
124 0           $self->_clear_cookie;
125 0           $self->_clear_user;
126            
127 0           return $self;
128             }
129            
130             sub _raw_query {
131 0     0     my ($self, %args) = @_;
132            
133             # common parameters
134 0           $args{'jsonrpc'} = '2.0';
135 0 0         $args{'auth'} = $self->cookie if $self->cookie;
136 0           $args{'id'} = $global_id++;
137            
138 0           my $response = eval { $self->ua->post($self->server,
  0            
139             'Content-Type' => 'application/json-rpc',
140             Content => encode_json(\%args)) };
141            
142 0 0         if (my $error = $@) {
143 0           confess $error;
144             }
145            
146 0           Log::Any->get_logger->trace($response->request->as_string);
147 0           Log::Any->get_logger->debug($response->as_string);
148            
149 0           return $response;
150             }
151            
152             sub query {
153 0     0 1   my $self = shift;
154 0           my %args = validate(@_, { method => { TYPE => SCALAR },
155             params => { TYPE => HASHREF,
156             optional => 1 }});
157            
158 0           my $response = $self->_raw_query(%args);
159            
160 0 0         if ($response->is_success) {
161 0           my $decoded = decode_json($response->decoded_content);
162 0 0         if ($decoded->{error}) {
163             croak(sprintf('While calling method %s, Zabbix server replied: %s',
164             $args{method},
165 0           $decoded->{error}->{data}));
166             }
167 0           return $decoded->{result};
168             }
169            
170 0           croak 'Received HTTP error: '.$response->decoded_content;
171             }
172            
173             sub fetch {
174 0     0 1   my $self = shift;
175 0           my $class = shift;
176 0           my %args = validate(@_,
177             { params => { type => HASHREF,
178             default => {} } });
179            
180 0           $class =~ s/^(?:Zabbix2::API::)?/Zabbix2::API::/;
181            
182 0 0         unless (Module::Loaded::is_loaded($class)) {
183 0           eval { Module::Load::load($class) };
  0            
184 0 0         if (my $error = $@) {
185 0           croak qq{Could not load class '$class': $error};
186             }
187 0 0         $class->can('new')
188             or croak "Class '$class' does not implement required 'new' method";
189 0 0         $class->can('_prefix')
190             or croak "Class '$class' does not implement required '_prefix' method";
191 0 0         $class->can('_extension')
192             or croak "Class '$class' does not implement required '_extension' method";
193             }
194            
195             my $response = $self->query(method => $class->_prefix('.get'),
196             params => {
197 0           %{$args{params}},
  0            
198             $class->_extension
199             });
200            
201 0           return [ map { $class->new(root => $self, data => $_) } @{$response} ];
  0            
  0            
202             }
203            
204             sub fetch_single {
205 0     0 1   my ($self, $class, %args) = @_;
206            
207 0           my $results = $self->fetch($class, %args);
208 0           my $result_count = scalar @{$results};
  0            
209            
210 0 0         if ($result_count > 1) {
211 0           croak qq{Too many results for 'fetch_single': expected 0 or 1, got $result_count};
212             }
213            
214 0           return $results->[0];
215             }
216            
217             1;
218             __END__