File Coverage

blib/lib/Zabbix2/API.pm
Criterion Covered Total %
statement 35 110 31.8
branch 0 26 0.0
condition 0 2 0.0
subroutine 12 21 57.1
pod 7 7 100.0
total 54 166 32.5


line stmt bran cond sub pod time code
1             package Zabbix2::API;
2              
3 13     13   406909 use strict;
  13         19  
  13         328  
4 13     13   88 use warnings;
  13         14  
  13         253  
5 13     13   214 use 5.010;
  13         37  
6 13     13   43 use Carp;
  13         12  
  13         613  
7              
8 13     13   4644 use Moo::Lax;
  13         142970  
  13         54  
9              
10 13     13   16090 use Scalar::Util qw/blessed/;
  13         15  
  13         635  
11 13     13   4810 use Module::Loaded;
  13         5805  
  13         606  
12 13     13   4911 use Module::Load;
  13         9927  
  13         58  
13 13     13   5858 use Params::Validate qw/validate :types/;
  13         59495  
  13         1975  
14 13     13   7002 use JSON;
  13         109622  
  13         41  
15 13     13   7991 use LWP::UserAgent;
  13         400460  
  13         437  
16 13     13   5504 use Log::Any;
  13         74066  
  13         46  
17              
18             our $VERSION = '0.010';
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             sub _build_ua {
38 0     0     my $self = shift;
39 0           return LWP::UserAgent->new(agent => 'Zabbix API client (libwww-perl)');
40             }
41              
42             sub useragent {
43 0     0 1   return shift->ua;
44             }
45              
46             sub login {
47 0     0 1   my $self = shift;
48 0           my %args = validate(@_, { user => 1,
49             password => 1 });
50 0           $self->_clear_cookie;
51 0           $self->_clear_user;
52 0           my $response = $self->_raw_query(method => 'user.login',
53             params => \%args);
54 0           my $decoded = eval { decode_json($response->decoded_content) };
  0            
55              
56 0 0         if (my $error = $@) {
57             # probably could not connect at all
58 0           croak sprintf('Could not connect: %s (%s, %s)',
59             $error, $response->code, $response->message);
60             }
61              
62 0 0         if ($decoded->{error}) {
63 0           croak 'Could not log in: '.$decoded->{error}->{data};
64             }
65              
66 0           $self->_set_cookie($decoded->{result});
67 0           $self->_set_user($args{user});
68              
69 0           return $self;
70             }
71              
72             sub logout {
73              
74 0     0 1   my $self = shift;
75 0           my $response = $self->_raw_query(method => 'user.logout');
76 0           my $decoded = eval { decode_json($response->decoded_content) };
  0            
77              
78 0 0         if (my $error = $@) {
79             # probably could not connect at all
80 0           croak sprintf('Could not log out: %s (%s, %s)',
81             $error, $response->code, $response->message);
82             }
83              
84 0 0         if ($decoded->{error}) {
85 0           croak 'Could not log out: '.$decoded->{error}->{data};
86             }
87              
88 0           $self->_clear_cookie;
89 0           $self->_clear_user;
90              
91 0           return $self;
92             }
93              
94             sub _raw_query {
95 0     0     my ($self, %args) = @_;
96              
97 0           state $global_id = int(rand(10000));
98              
99             # common parameters
100 0           $args{'jsonrpc'} = '2.0';
101 0   0       $args{'auth'} = $self->cookie || '';
102 0           $args{'id'} = $global_id++;
103              
104 0           my $response = eval { $self->ua->post($self->server,
  0            
105             'Content-Type' => 'application/json-rpc',
106             Content => encode_json(\%args)) };
107              
108 0 0         if (my $error = $@) {
109 0           confess $error;
110             }
111              
112 0           Log::Any->get_logger->trace($response->request->as_string);
113 0           Log::Any->get_logger->debug($response->as_string);
114              
115 0           return $response;
116             }
117              
118             sub query {
119 0     0 1   my $self = shift;
120 0           my %args = validate(@_, { method => { TYPE => SCALAR },
121             params => { TYPE => HASHREF,
122             optional => 1 }});
123              
124 0           my $response = $self->_raw_query(%args);
125              
126 0 0         if ($response->is_success) {
127 0           my $decoded = decode_json($response->decoded_content);
128 0 0         if ($decoded->{error}) {
129             croak(sprintf('While calling method %s, Zabbix server replied: %s',
130             $args{method},
131 0           $decoded->{error}->{data}));
132             }
133 0           return $decoded->{result};
134             }
135              
136 0           croak 'Received HTTP error: '.$response->decoded_content;
137             }
138              
139             sub api_version {
140 0     0 1   my $self = shift;
141 0           return $self->query(method => 'apiinfo.version');
142             }
143              
144             sub fetch {
145 0     0 1   my $self = shift;
146 0           my $class = shift;
147 0           my %args = validate(@_,
148             { params => { type => HASHREF,
149             default => {} } });
150              
151 0           $class =~ s/^(?:Zabbix2::API::)?/Zabbix2::API::/;
152              
153 0 0         unless (Module::Loaded::is_loaded($class)) {
154 0           eval { Module::Load::load($class) };
  0            
155 0 0         if (my $error = $@) {
156 0           croak qq{Could not load class '$class': $error};
157             }
158 0 0         $class->can('new')
159             or croak "Class '$class' does not implement required 'new' method";
160 0 0         $class->can('_prefix')
161             or croak "Class '$class' does not implement required '_prefix' method";
162 0 0         $class->can('_extension')
163             or croak "Class '$class' does not implement required '_extension' method";
164             }
165              
166             my $response = $self->query(method => $class->_prefix('.get'),
167             params => {
168 0           %{$args{params}},
  0            
169             $class->_extension
170             });
171              
172 0           return [ map { $class->new(root => $self, data => $_) } @{$response} ];
  0            
  0            
173             }
174              
175             sub fetch_single {
176 0     0 1   my ($self, $class, %args) = @_;
177              
178 0           my $results = $self->fetch($class, %args);
179 0           my $result_count = scalar @{$results};
  0            
180              
181 0 0         if ($result_count > 1) {
182 0           croak qq{Too many results for 'fetch_single': expected 0 or 1, got $result_count};
183             }
184              
185 0           return $results->[0];
186             }
187              
188             1;
189             __END__