File Coverage

line	stmt	bran	cond	sub	pod	time	code
1							#
2							# status reporter
3							#
4							package Xymon::Plugin::Server::Status;
5
6	3			3		57917	use strict;
	3					8
	3					139
7
8	3			3		19	use Carp;
	3					6
	3					297
9
10	3			3		1179	use Xymon::Plugin::Server;
	3					6
	3					148
11
12							=head1 NAME
13
14							Xymon::Plugin::Server::Status - Xymon status reporter
15
16							=head1 SYNOPSIS
17
18							use Xymon::Plugin::Server::Status qw(:colors);
19							my $status = Xymon::Plugin::Server::Status->new("myhostname", "test");
20
21							$status->add_status(GREEN, "this entry is OK");
22							$status->add_status(RED, "this entry is NOT OK");
23							$status->add_message("Hello! world");
24
25							$status->add_devmon($devmon); # see Xymon::Plugin::Server::Devmon
26
27							$status->add_graph("disk");
28
29							$status->report; # send status to Xymon server
30
31							=head1 EXPORT
32
33							Color names
34
35							GREEN YELLOW RED CLEAR PURPLE BLUE
36
37							are exported with tag ':colors'
38
39							=cut
40
41	3			3		19	use base qw(Exporter);
	3					6
	3					776
42
43							my @colors = qw(GREEN YELLOW RED CLEAR PURPLE BLUE);
44
45							our @EXPORT_OK = @colors;
46							our %EXPORT_TAGS = (colors => \@colors);
47
48							use constant {
49	3					5311	GREEN => 'green',
50							YELLOW => 'yellow',
51							RED => 'red',
52							CLEAR => 'clear',
53							PURPLE => 'purple',
54							BLUE => 'blue',
55	3			3		26	};
	3					5
56
57							=head1 SUBROUTINES/METHODS
58
59							=head2 new(hostname, testname, attr)
60
61							Create status object for hostname and testname.
62
63							attr is optional hashref to change actions of object.
64							Currently, following parameter is defined.
65
66							=over
67
68							=item EscapeMessage
69
70							=over
71
72							=item 0 - nochange (default)
73
74							Make no change to message.
75
76							=item 1 - replace to '_'
77
78							Some characters (<, >, &) are replaced to '_'.
79
80							=item 2 - html escape
81
82							'<', '>, '&' are replaced to '<', '>', '&' respectively.
83
84							=back
85
86							=back
87
88							=cut
89
90							sub new {
91	23			23	1	26671	my $class = shift;
92	23					56	my $host = shift;
93	23					33	my $test = shift;
94	23					27	my $attr = shift;
95
96	23		100			299	my $self = {
97							_host => $host,
98							_test => $test,
99							_color => 'clear',
100							_message => '',
101							_devmon => undef,
102							_graph => [],
103							_attr => $attr || {}
104							};
105
106	23					90	bless $self, $class;
107							}
108
109							#
110							# CLEAR, BLUE, GREEN, PURPLE, YELLOW, RED
111							#
112							my %order = (CLEAR , 0,
113							BLUE , 1,
114							GREEN , 2,
115							PURPLE , 3,
116							YELLOW , 4,
117							RED , 5,
118							);
119
120							sub _set_color {
121	29			29		35	my $self = shift;
122	29					33	my $color = shift;
123
124	29					55	my $cur = $order{$self->{_color}};
125	29					37	my $new = $order{$color};
126
127	29	50				62	carp "Unknown color: $color" unless (defined($new));
128
129							# if purple is selected, this report will be eliminated by Xymon.
130							# so we change color.
131	29	50				81	if ($color eq PURPLE) {
132	0					0	$color = YELLOW;
133	0					0	$new = $order{$color};
134							}
135
136	29	100				65	if ($cur < $new) {
137	23					33	$self->{_color} = $color;
138							}
139
140	29					63	return $self->{_color};
141							}
142
143							=head2 add_status(color, msg)
144
145							Add status and its short message.
146
147							=cut
148
149							sub add_status {
150	29			29	1	131	my $self = shift;
151	29					57	my ($color, $msg) = @_;
152
153	29	100				103	if (defined($msg)) {
154	23	50				89	$msg .= "\n" if ($msg !~ /\n$/);
155	23					54	my $m = $self->_escape_string($msg);
156
157	23					74	$self->{_message} .= "&$color $m";
158							}
159
160	29					58	$self->_set_color($color);
161							}
162
163							=head2 add_message(msg)
164
165							Add message shown in Xymon status page.
166
167							=cut
168
169							sub add_message {
170	9			9	1	44	my $self = shift;
171	9					14	my ($msg) = @_;
172
173	9	50				37	$msg .= "\n" if ($msg !~ /\n$/);
174
175	9					21	$self->{_message} .= $self->_escape_string($msg);
176							}
177
178							=head2 add_devmon(devmon)
179
180							Add devmon data. See Xymon::Plugin::Server::Devmon
181
182							=cut
183
184							sub add_devmon {
185	2			2	1	21	my $self = shift;
186	2					3	my $devmon= shift;
187
188	2					4	$self->{_devmon} = $devmon;
189							}
190
191							=head2 add_graph(testname)
192
193							Add graph shown in Xymon status page.
194							"test" name must be defined in graph definition file.
195							(named hobbitgraph.cfg in Xymon 4.2, graphs.cfg in Xymon 4.3)
196
197							=cut
198
199							sub add_graph {
200	2			2	1	11	my $self = shift;
201	2					4	my $test= shift;
202
203	2					4	push (@{$self->{_graph}}, $test);
	2					11
204							}
205
206							sub _create_graph_html {
207	2			2		5	my $self = shift;
208	2					6	my $test = shift;
209
210	2					4	my $type = "4.3";
211
212	2					3	my ($major, $minor) = @{Xymon::Plugin::Server->version};
	2					19
213	2	100	66			25	$type = "4.2" if ($major == 4 && $minor == 2);
214
215	2					6	my $host = $self->{_host};
216	2					4	my $color = $self->{_color};
217	2		50			24	my $width = $ENV{RRDWIDTH} || 576;
218	2		50			25	my $height = $ENV{RRDHEIGHT} || 120;
219	2					5	my $end_time = time;
220	2					4	my $start_time = time - (60 * 60 * 48);
221
222	2	100				8	if ($type eq "4.2") {
223	1		50			5	my $cgi_url = $ENV{BBSERVERCGIURL} || "/xymon-cgi";
224
225	1					20	my $html = << "_EOS";
226
227
228
229
230
231
232							_EOS
233							}
234							else {
235	1		50			7	my $cgi_url = $ENV{XYMONSERVERCGIURL} || "/xymon-cgi";
236
237	1					16	my $html = << "_EOS";
238
239
240
241
242
243							_EOS
244
245							}
246							}
247
248							sub _escape_replace {
249	2			2		4	my $s = shift;
250	2					10	$s =~ s/[<>&]/_/g;
251	2					5	return $s;
252							}
253
254							sub _escape_entity {
255	2			2		4	my $s = shift;
256
257	2					14	$s =~ s/&/&/g;
258	2					4	$s =~ s/
259	2					5	$s =~ s/>/>/g;
260	2					6	return $s;
261							}
262
263							sub _escape_string {
264	32			32		30	my $self = shift;
265	32					38	my $s = shift;
266
267	32	100				66	if ($self->{_attr}->{EscapeMessage}) {
268	4					14	my $n = $self->{_attr}->{EscapeMessage};
269	4	100				18	if ($n == 1) {
		50
270	2					8	return _escape_replace($s);
271							}
272							elsif ($n == 2) {
273	2					13	return _escape_entity($s);
274							}
275
276							}
277
278	28					62	return $s;
279							}
280
281							sub _create_report_msg {
282	23			23		37	my $self = shift;
283
284	23					236	local $ENV{LANG} = 'C';
285	23					875	my $datestr = scalar localtime time;
286	23					52	my $statstr = '';
287
288	23	100	100			146	if ($self->{_color} eq GREEN) {
		100
289	11					25	$statstr = ' - OK';
290							}
291							elsif ($self->{_color} eq YELLOW || $self->{_color} eq RED) {
292	10					25	$statstr = ' - NOT OK';
293							}
294
295							my $msg = sprintf("status %s.%s %s %s %s%s\n",
296							$self->{_host},
297							$self->{_test},
298							$self->{_color},
299							$datestr,
300							$self->{_test},
301	23					113	$statstr);
302
303	23					38	$msg .= "\n";
304	23					34	$msg .= $self->{_message};
305
306	23	100				58	if ($self->{_devmon}) {
307	2					5	$msg .= "\n";
308	2					11	$msg .= $self->{_devmon}->format;
309							}
310
311	23	100				35	if (@{$self->{_graph}} > 0) {
	23					68
312	2					14	$msg .= "

\n";