File Coverage

blib/lib/Nagios/Scrape.pm
Criterion Covered Total %
statement 29 62 46.7
branch 12 18 66.6
condition 2 3 66.6
subroutine 8 13 61.5
pod 8 8 100.0
total 59 104 56.7


)
line stmt bran cond sub pod time code
1             package Nagios::Scrape;
2              
3 2     2   54030 use warnings;
  2         4  
  2         56  
4 2     2   11 use strict;
  2         4  
  2         56  
5              
6 2     2   3877 use CGI;
  2         44909  
  2         15  
7 2     2   4387 use LWP::UserAgent;
  2         131025  
  2         66  
8 2     2   2733 use Error;
  2         11040  
  2         11  
9              
10             =head1 NAME
11              
12             Nagios::Scrape - Scrapes and Parses the status.cgi page of a Nagios installation
13              
14             =head1 VERSION
15              
16             Version 0.03
17              
18             =cut
19              
20             our $VERSION = '0.03';
21              
22             =head1 SYNOPSIS
23              
24             This module uses LWP to retrieve the status.cgi page of a Nagios installation, parses
25             the data into a manageable format, and then makes it accessible.
26              
27             This is a more lightweight solution to Nagios installations where the status.dat file
28             can reach 1+mb in size.
29              
30             use Nagios::Scrape;
31              
32             my $foo = Nagios::Scrape->new(username => $username, password => $password, url => $url);
33             @service_alerts = $foo->get_service_status();
34             @host_alerts = $foo->get_host_status();
35              
36             =head1 SUBROUTINES/METHODS
37              
38             =head2 new
39              
40             Creates a new class given a username and password.
41              
42             my $nagios = Nagios::Scrape->new(username => $username, password => $password, url => $url);
43              
44             =cut
45              
46             sub new {
47 6     6 1 3347 my ( $class, %attrs ) = @_;
48              
49 6 100       35 throw Error::Simple("Username is required") if ( !defined( $attrs{username} ) );
50 5 100       19 throw Error::Simple("Password is required") if ( !defined( $attrs{password} ) );
51 4 100       18 throw Error::Simple("URL is required") if ( !defined( $attrs{url} ) );
52              
53 3 100 66     30 throw Error::Simple("Invalid URL. Example: http://localhost/cgi-bin/status.cgi")
54             if ( ( $attrs{url} !~ m/^http/ ) || ( $attrs{url} !~ m/status.cgi$/ ) );
55              
56             # Sets default values for host and service states
57 1         2 $attrs{host_state} = 12;
58 1         4 $attrs{service_state} = 28;
59              
60 1         10 bless \%attrs, $class;
61              
62             }
63              
64             =head2 host_state
65              
66             This method allows you to filter certain host states. The table is as follows:
67              
68             Hosts:
69             PENDING 1
70             UP 2
71             DOWN 4
72             UNREACHABLE 8
73              
74             Add the number for each state that you want to see. For example, to see DOWN
75             and UNREACHABLE states, set this value to 12. (Default value).
76              
77             =cut
78              
79             sub host_state {
80 3     3 1 7 my ( $self, $state ) = @_;
81 3 100       10 $self->{host_state} = $state if ( defined($state) );
82 3         14 return $self->{host_state};
83             }
84              
85             =head2 service_state
86              
87             This method allows you to filter certain service states. The table is as follows:
88              
89             Services:
90             PENDING 1
91             OK 2
92             WARNING 4
93             UNKNOWN 8
94             CRITICAL 16
95              
96             Add the number for each state you would like to see. For example, to see WARNING,
97             UNKNOWN, and CRITICAL states, set the number to 28. (Default value).
98              
99             =cut
100              
101             sub service_state {
102 3     3 1 9 my ( $self, $state ) = @_;
103 3 100       8 $self->{service_state} = $state if ( defined($state) );
104 3         11 return $self->{service_state};
105             }
106              
107             =head2 get_service_status
108              
109             Connects to given URL and retrieves the requested service statuses
110              
111             =cut
112              
113             sub get_service_status {
114 0     0 1   my $self = shift;
115 0           my $ua = LWP::UserAgent->new;
116 0           my $req =
117             HTTP::Request->new( GET => $self->{url}
118             . '?host=all&noheader=yes&servicestatustypes='
119             . $self->{service_state} );
120 0           $req->authorization_basic( $self->{username}, $self->{password} );
121 0           my $response = $ua->request($req);
122              
123 0 0         if ( !$response->is_success ) {
124 0           die( "Could not connect to "
125             . $self->{url} . " "
126             . $response->status_line
127             . "\n" );
128             }
129              
130 0           return $self->parse_service_content( $response->content );
131              
132             }
133              
134             =head2 get_host_status
135              
136             Connects to given url and retrieves host statuses
137              
138             =cut
139              
140             sub get_host_status {
141 0     0 1   my $self = shift;
142 0           my $ua = LWP::UserAgent->new;
143 0           my $req =
144             HTTP::Request->new( GET => $self->{url}
145             . '?hostgroup=all&noheader=yes&style=hostdetail&hoststatustypes='
146             . $self->{host_state} );
147 0           $req->authorization_basic( $self->{username}, $self->{password} );
148 0           my $response = $ua->request($req);
149              
150 0 0         if ( !$response->is_success ) {
151 0           die( "Could not connect to "
152             . $self->{url} . " "
153             . $response->status_line
154             . "\n" );
155             }
156              
157 0           return $self->parse_host_content( $response->content );
158             }
159              
160              
161             =head2 parse_service_content
162              
163             Will parse the service status page into a manageable array of hashed service details.
164              
165             =cut
166              
167             sub parse_service_content {
168 0     0 1   my ( $self, $content ) = @_;
169              
170 0           my @alerts;
171             my $host;
172              
173 0           while (
174             $content =~ m%
175             (?:
176            
177             .+?
178             # Host name - will be empty TD pair if this is a continuation
179             # of a host with multiple alerts
180             '>([^<]+)|
181             .+?
182             # ' Service description
183             >([^<]+)
184             .+?
185             # Status
186             CLASS='status[A-Z]+'>([A-Z]+)
187             .+?
188             # ' Time
189             nowrap>([^<]+)
190             .+?
191             # Duration
192             nowrap>([^<]+)
193             .+?
194             # Attempts
195             >([^<]+)
196             .+?
197             # Status Information
198             >([^<]+)
199             .+?
200             %xsmgi
201             )
202             {
203              
204             # Host might be empty if this is a host with multiple alerts
205 0 0         $host = $1 if (defined($1));
206              
207 0           my $alert = {
208             'type' => 'service',
209             'host' => $self->decode_html($host),
210             'service' => $self->decode_html($2),
211             'status' => $self->decode_html($3),
212             'time' => $self->decode_html($4),
213             'duration' => $self->decode_html($5),
214             'attempts' => $self->decode_html($6),
215             'information' => $self->decode_html($7)
216             };
217              
218 0           push( @alerts, $alert );
219              
220             }
221              
222 0           return @alerts;
223             }
224              
225             =head2 parse_host_content
226              
227             Will parse the host status page into a manageable array of hashed service details.
228              
229             =cut
230              
231             sub parse_host_content {
232 0     0 1   my ($self, $content) = @_;
233 0           my @alerts;
234              
235 0           while ($content =~ m%
236            
237             .+?
238             # Host name
239             >([^<]+)
240             .+?
241             # Status
242             ([^<]+)
243             .+?
244             # Time
245             nowrap>([^<]+)
246             .+?
247             # Duration
248             nowrap>([^<]+)
249             .+?
250             # Status Information
251             >([^<]+)
252             .+?
253             %xsmgi) {
254              
255 0           my $alert = {
256             'type' => 'host',
257             'host' => $self->decode_html($1),
258             'status' => $self->decode_html($2),
259             'time' => $self->decode_html($3),
260             'duration' => $self->decode_html($4),
261             'information' => $self->decode_html($5)
262             };
263 0           push(@alerts, $alert);
264             }
265              
266 0           return @alerts;
267             }
268              
269             =head2 decode_html
270              
271             Simple helper method that smooths out HTML strings from Nagios status.cgi page
272              
273             =cut
274              
275             sub decode_html {
276 0     0 1   my ( $self, $string ) = @_;
277 0           $string = CGI::unescapeHTML($string);
278 0           $string =~ s/nbsp//g;
279              
280 0           return $string;
281             }
282              
283             =head1 AUTHOR
284              
285             Joe Topjian, C<< >>
286              
287             =head1 BUGS
288              
289             Please report any bugs or feature requests to C, or through
290             the web interface at L. I will be notified, and then you'll
291             automatically be notified of progress on your bug as I make changes.
292              
293              
294              
295              
296             =head1 SUPPORT
297              
298             You can find documentation for this module with the perldoc command.
299              
300             perldoc Nagios::Scrape
301              
302              
303             =head1 ACKNOWLEDGEMENTS
304              
305             Some of this code was taken from www.nagios3book.com/nagios-3-enm/tts/nagios-ttsd.pl which is no longer online.
306              
307             =head1 LICENSE AND COPYRIGHT
308              
309             Copyright 2010 Joe Topjian.
310              
311             This program is free software; you can redistribute it and/or modify it
312             under the terms of either: the GNU General Public License as published
313             by the Free Software Foundation; or the Artistic License.
314              
315             See http://dev.perl.org/licenses/ for more information.
316              
317              
318             =cut
319              
320             1; # End of Nagios::Scrape