File Coverage

blib/lib/Monit/HTTP.pm
Criterion Covered Total %
statement 103 127 81.1
branch 19 34 55.8
condition 12 32 37.5
subroutine 19 22 86.3
pod 8 8 100.0
total 161 223 72.2


line stmt bran cond sub pod time code
1             #!/bin/false
2             # ABSTRACT: An OOP interface to Monit.
3             # PODNAME: Monit::HTTP
4              
5 5     5   502803 use warnings;
  5         62  
  5         165  
6 5     5   27 use strict;
  5         8  
  5         93  
7 5     5   54 use v5.10;
  5         18  
8              
9             package Monit::HTTP;
10             $Monit::HTTP::VERSION = '0.06';
11 5     5   3701 use HTTP::Tiny;
  5         234656  
  5         241  
12 5     5   2406 use XML::Fast;
  5         56837  
  5         299  
13 5     5   34 use Carp qw( croak );
  5         11  
  5         1070  
14              
15             our (
16             %MONIT_ACTIONS,
17             %MONIT_ACTIONS_REV,
18             %MONIT_STATUS,
19             %MONIT_STATUS_REV,
20             %MONIT_TYPES,
21             %MONIT_TYPES_REV,
22             %MONIT_MONITOR,
23             %MONIT_MONITOR_REV,
24             );
25              
26             BEGIN {
27              
28 5     5   39 %MONIT_ACTIONS_REV = (
29             'stop' => 'ACTION_STOP',
30             'start' => 'ACTION_START',
31             'restart' => 'ACTION_RESTART',
32             'monitor' => 'ACTION_MONITOR',
33             'unmonitor' => 'ACTION_UNMONITOR',
34             );
35 5         54 %MONIT_ACTIONS = reverse %MONIT_ACTIONS_REV;
36              
37 5         23 %MONIT_MONITOR_REV = (
38             0 => 'off',
39             1 => 'monitored',
40             2 => 'initializing',
41             );
42 5         28 %MONIT_MONITOR = reverse %MONIT_MONITOR_REV;
43              
44 5         23 %MONIT_STATUS_REV = (
45             0 => 'Running',
46             32 => 'Connection Failed',
47             512 => 'Does not exist',
48             );
49 5         23 %MONIT_STATUS = reverse %MONIT_STATUS_REV;
50              
51 5         36 %MONIT_TYPES_REV = (
52             0 => 'TYPE_FILESYSTEM',
53             1 => 'TYPE_DIRECTORY',
54             2 => 'TYPE_FILE',
55             3 => 'TYPE_PROCESS',
56             4 => 'TYPE_HOST',
57             5 => 'TYPE_SYSTEM',
58             6 => 'TYPE_FIFO',
59             7 => 'TYPE_STATUS',
60             );
61 5         330 %MONIT_TYPES = reverse %MONIT_TYPES_REV;
62              
63             }
64              
65             # This creates constants from all the above values
66             # perl 5.10 has strange issues just going:
67             # use constant reverse %{ MONIT_TYPES() }
68             # So work around it with do {}
69 5     5   34 use constant do { my %foo = reverse( %MONIT_TYPES_REV ); \%foo };
  5         18  
  5         12  
  5         32  
  5         816  
70 5     5   38 use constant do { my %foo = reverse( %MONIT_ACTIONS_REV ); \%foo };
  5         8  
  5         20  
  5         34  
  5         527  
71              
72 5     5   923 use parent qw(Exporter);
  5         648  
  5         36  
73             our (%EXPORT_TAGS, @EXPORT_OK);
74              
75             %EXPORT_TAGS = (
76             constants => [qw/
77             ACTION_MONITOR
78             ACTION_RESTART
79             ACTION_START
80             ACTION_STOP
81             ACTION_UNMONITOR
82              
83             TYPE_DIRECTORY
84             TYPE_FIFO
85             TYPE_FILE
86             TYPE_FILESYSTEM
87             TYPE_HOST
88             TYPE_PROCESS
89             TYPE_SYSTEM
90             /],
91              
92             hashes => [qw/
93             %MONIT_ACTIONS
94             %MONIT_ACTIONS_REV
95             %MONIT_STATUS
96             %MONIT_STATUS_REV
97             %MONIT_TYPES
98             %MONIT_TYPES_REV
99             %MONIT_MONITOR
100             %MONIT_MONITOR_REV
101             /],
102             );
103              
104             @EXPORT_OK = (
105             @{$EXPORT_TAGS{constants}},
106             @{$EXPORT_TAGS{hashes}},
107             );
108              
109             Exporter::export_ok_tags( keys %EXPORT_TAGS );
110              
111              
112             sub new {
113 3     3 1 2485 my ($class, %self) = @_;
114              
115             # OOP stuff
116 3   33     22 $class = ref($class) || $class;
117 3         9 my $self = \%self;
118 3         19 bless $self, $class;
119              
120             # set some defaults, if not already set
121 3   100     42 $self->{hostname} ||= 'localhost';
122 3   50     20 $self->{port} ||= 2812;
123 3   50     17 $self->{use_auth} ||= 0;
124 3 50       10 if($self->{use_auth}) {
125 0   0     0 $self->{username} ||= 'admin';
126 0   0     0 $self->{password} ||= 'monit';
127             }
128              
129 3         33 $self->{ua} = HTTP::Tiny->new( agent => sprintf('Perl %s/%s',__PACKAGE__,$Monit::HTTP::VERSION) );
130 3         312 $self->_generate_url;
131              
132 3         9 return $self
133             }
134              
135             sub _generate_url {
136              
137 5     5   20 my $self = shift;
138              
139 5         12 my $auth = '';
140 5 0 33     32 if (defined $self->{username} and defined $self->{password} and $self->{use_auth}) {
      33        
141             $auth = sprintf('%s:%s@',$self->{username},$self->{password})
142 0         0 }
143              
144             $self->{status_url} = sprintf('http://%s%s:%d/_status?format=xml',
145 5         42 $auth, $self->{hostname}, $self->{port});
146             }
147              
148              
149             sub set_hostname {
150 1     1 1 3113 my ($self, $hostname) = @_;
151 1         7 $self->{hostname} = $hostname;
152 1         7 $self->_generate_url;
153 1         7 return $hostname
154             }
155              
156              
157             sub set_port {
158 1     1 1 2067 my ($self, $port) = @_;
159 1         3 $self->{port} = $port;
160 1         3 $self->_generate_url;
161 1         4 return $port
162             }
163              
164              
165             sub set_username {
166 0     0 1 0 my ($self, $username) = @_;
167 0         0 $self->{username} = $username;
168 0         0 $self->_generate_url;
169 0         0 return $username
170             }
171              
172              
173             sub set_password {
174 0     0 1 0 my ($self, $password ) = @_;
175 0         0 $self->{password} = $password;
176 0         0 $self->_generate_url;
177 0         0 return $password
178             }
179              
180              
181             sub _fetch_info {
182 7     7   17 my ($self) = @_;
183              
184 7         161 my $res = $self->{ua}->get( $self->{status_url} );
185 7 100       31987 if ($res->{success}) {
186 3         9 $self->_set_xml($res->{content});
187 3         9 $self->{xml_hash} = xml2hash( $self->_get_xml );
188             }
189             else {
190             croak sprintf "Error while connecting to %s !\n" .
191             "Status: %s\nReason: %s\nContent: %s\n",
192 4   50     948 $self->{status_url}, $res->{status}, $res->{reason}, $res->{content} || 'NIL';
193             }
194              
195 3         765 return 1
196             }
197              
198              
199             sub get_services {
200 5     5 1 7475 my ($self, $type) = @_;
201 5         11 my @services;
202 5   50     30 $type ||= '-1';
203              
204             croak "Don't understand this service type!\n"
205 5 50 33     37 unless $type == -1 or grep {$_ == $type} keys %{MONIT_TYPES()};
  0         0  
  0         0  
206              
207 5         21 $self->_fetch_info;
208              
209 1         2 for my $s (@{$self->{xml_hash}->{monit}->{service}}) {
  1         5  
210 2 50 33     7 if ($type == -1 or $s->{'-type'} == $type) {
211 2         5 push @services, $s->{name};
212             }
213             }
214 1         5 return @services;
215             }
216              
217              
218             sub _set_xml {
219 3     3   8 my ($self, $xml) = @_;
220 3         6 $self->{status_raw_content} = $xml;
221             }
222              
223              
224             sub _get_xml {
225 4     4   1384 my ($self) = @_;
226 4         37 return $self->{status_raw_content};
227             }
228              
229              
230             sub service_status {
231 2     2 1 1221 my ($self, $service) = @_;
232 2         5 my $status_href = {};
233              
234 2         6 $self->_fetch_info;
235              
236 2         5 for my $s (@{$self->{xml_hash}->{monit}->{service}}) {
  2         7  
237 4 100       12 if ($s->{name} eq $service) {
238              
239 2         5 $status_href->{host} = $self->{hostname};
240              
241             $status_href->{'type'} = $s->{'-type'}
242 2 50       8 if exists $s->{'-type'};
243              
244 2         6 for my $thing (qw/
245             children
246             collected_sec
247             collected_usec
248             euid
249             gid
250             group
251             monitor
252             monitormode
253             pid
254             ppid
255             name
256             pendingaction
257             status
258             status_hint
259             uid
260             uptime
261             /) {
262              
263             $status_href->{$thing} = $s->{$thing}
264 32 100       67 if exists $s->{$thing};
265              
266             } # main stuff loop
267              
268             # the 'system' (type 5) service sticks these things in to ->{system}, others are top level
269 2 50 33     11 if (my $sys = $s->{system} || $s) {
270 2         5 for my $thing (qw/ kilobyte kilobytetotal percent percenttotal /) {
271             $status_href->{memory}->{$thing} = $sys->{memory}->{$thing}
272 8 100       24 if exists $sys->{memory}->{$thing};
273             } # memory loop
274              
275 2         4 for my $thing (qw/ kilobyte percent /) {
276             $status_href->{swap}->{$thing} = $sys->{swap}->{$thing}
277 4 50       10 if exists $sys->{swap}->{$thing};
278             } # swap loop
279              
280 2         4 for my $thing (qw/ percent percenttotal /) {
281             $status_href->{cpu}->{$thing} = $sys->{cpu}->{$thing}
282 4 100       12 if exists $sys->{cpu}->{$thing};
283             } # cpu loop
284              
285 2         5 for my $thing (qw/ avg01 avg05 avg15 /) {
286             $status_href->{load}->{$thing} = $sys->{load}->{$thing}
287 6 100       18 if exists $sys->{load}->{$thing};
288             } # load loop
289              
290             }
291             }
292             }
293              
294 2 50       8 croak "Service $service does not exist\n"
295             unless scalar keys %$status_href;
296              
297 2         8 return $status_href
298              
299             }
300              
301              
302             sub command_run {
303 0     0 1   my ($self, $service, $command) = @_;
304              
305             croak "Don't understand this action\n"
306 0 0         unless grep { $command eq $_ } keys %{MONIT_ACTIONS()};
  0            
  0            
307              
308 0 0         if(not defined $service) {
309 0           $self->{is_success} = 0;
310 0           croak "Service not specified\n";
311             }
312              
313             # if services does not exist throw error
314              
315 0           my $url = 'http://'.$self->{hostname}.':'.$self->{port}.'/'.$service;
316              
317 0           my $res = $self->{ua}->post_form($url, { action => $command });
318             croak $res->{status}
319 0 0         unless $res->{success};
320              
321 0           return 1
322             }
323              
324             1; # End of Monit::HTTP
325              
326             __END__