1 # collectd - Collectd.pm
2 # Copyright (C) 2007 Sebastian Harl
3 #
4 # This program is free software; you can redistribute it and/or modify it
5 # under the terms of the GNU General Public License as published by the
6 # Free Software Foundation; only version 2 of the License is applicable.
7 #
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 # General Public License for more details.
12 #
13 # You should have received a copy of the GNU General Public License along
14 # with this program; if not, write to the Free Software Foundation, Inc.,
15 # 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
16 #
17 # Author:
18 # Sebastian Harl <sh at tokkee.org>
20 package Collectd;
22 use strict;
23 use warnings;
25 use Config;
27 use threads;
28 use threads::shared;
30 BEGIN {
31 if (! $Config{'useithreads'}) {
32 die "Perl does not support ithreads!";
33 }
34 }
36 require Exporter;
38 our @ISA = qw( Exporter );
40 our %EXPORT_TAGS = (
41 'plugin' => [ qw(
42 plugin_register
43 plugin_unregister
44 plugin_dispatch_values
45 plugin_dispatch_notification
46 plugin_log
47 ) ],
48 'types' => [ qw(
49 TYPE_INIT
50 TYPE_READ
51 TYPE_WRITE
52 TYPE_SHUTDOWN
53 TYPE_LOG
54 TYPE_NOTIF
55 TYPE_DATASET
56 ) ],
57 'ds_types' => [ qw(
58 DS_TYPE_COUNTER
59 DS_TYPE_GAUGE
60 ) ],
61 'log' => [ qw(
62 ERROR
63 WARNING
64 NOTICE
65 INFO
66 DEBUG
67 LOG_ERR
68 LOG_WARNING
69 LOG_NOTICE
70 LOG_INFO
71 LOG_DEBUG
72 ) ],
73 'notif' => [ qw(
74 NOTIF_FAILURE
75 NOTIF_WARNING
76 NOTIF_OKAY
77 ) ],
78 'globals' => [ qw(
79 $hostname_g
80 $interval_g
81 ) ],
82 );
84 {
85 my %seen;
86 push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
87 foreach keys %EXPORT_TAGS;
88 }
90 # global variables
91 our $hostname_g;
92 our $interval_g;
94 Exporter::export_ok_tags ('all');
96 my @plugins : shared = ();
98 my %types = (
99 TYPE_INIT, "init",
100 TYPE_READ, "read",
101 TYPE_WRITE, "write",
102 TYPE_SHUTDOWN, "shutdown",
103 TYPE_LOG, "log",
104 TYPE_NOTIF, "notify"
105 );
107 foreach my $type (keys %types) {
108 $plugins[$type] = &share ({});
109 }
111 sub _log {
112 my $caller = shift;
113 my $lvl = shift;
114 my $msg = shift;
116 if ("Collectd" eq $caller) {
117 $msg = "perl: $msg";
118 }
119 return plugin_log ($lvl, $msg);
120 }
122 sub ERROR { _log (scalar caller, LOG_ERR, shift); }
123 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
124 sub NOTICE { _log (scalar caller, LOG_NOTICE, shift); }
125 sub INFO { _log (scalar caller, LOG_INFO, shift); }
126 sub DEBUG { _log (scalar caller, LOG_DEBUG, shift); }
128 sub plugin_call_all {
129 my $type = shift;
131 our $cb_name = undef;
133 if (! defined $type) {
134 return;
135 }
137 if (TYPE_LOG != $type) {
138 DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\"");
139 }
141 if (! defined $plugins[$type]) {
142 ERROR ("Collectd::plugin_call: unknown type \"$type\"");
143 return;
144 }
146 lock @plugins;
147 foreach my $plugin (keys %{$plugins[$type]}) {
148 my $p = $plugins[$type]->{$plugin};
150 my $status = 0;
152 if ($p->{'wait_left'} > 0) {
153 $p->{'wait_left'} -= $interval_g;
154 }
156 next if ($p->{'wait_left'} > 0);
158 $cb_name = $p->{'cb_name'};
159 $status = call_by_name (@_);
161 if (! $status) {
162 my $err = undef;
164 if ($@) {
165 $err = $@;
166 }
167 else {
168 $err = "callback returned false";
169 }
171 if (TYPE_LOG != $type) {
172 ERROR ("Execution of callback \"$cb_name\" failed: $err");
173 }
175 $status = 0;
176 }
178 if ($status) {
179 $p->{'wait_left'} = 0;
180 $p->{'wait_time'} = $interval_g;
181 }
182 elsif (TYPE_READ == $type) {
183 if ($p->{'wait_time'} < $interval_g) {
184 $p->{'wait_time'} = $interval_g;
185 }
187 $p->{'wait_left'} = $p->{'wait_time'};
188 $p->{'wait_time'} *= 2;
190 if ($p->{'wait_time'} > 86400) {
191 $p->{'wait_time'} = 86400;
192 }
194 WARNING ("${plugin}->read() failed with status $status. "
195 . "Will suspend it for $p->{'wait_left'} seconds.");
196 }
197 elsif (TYPE_INIT == $type) {
198 ERROR ("${plugin}->init() failed with status $status. "
199 . "Plugin will be disabled.");
201 foreach my $type (keys %types) {
202 plugin_unregister ($type, $plugin);
203 }
204 }
205 elsif (TYPE_LOG != $type) {
206 WARNING ("${plugin}->$types{$type}() failed with status $status.");
207 }
208 }
209 return 1;
210 }
212 # Collectd::plugin_register (type, name, data).
213 #
214 # type:
215 # init, read, write, shutdown, data set
216 #
217 # name:
218 # name of the plugin
219 #
220 # data:
221 # reference to the plugin's subroutine that does the work or the data set
222 # definition
223 sub plugin_register {
224 my $type = shift;
225 my $name = shift;
226 my $data = shift;
228 DEBUG ("Collectd::plugin_register: "
229 . "type = \"$type\", name = \"$name\", data = \"$data\"");
231 if (! ((defined $type) && (defined $name) && (defined $data))) {
232 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
233 return;
234 }
236 if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)) {
237 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
238 return;
239 }
241 if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
242 return plugin_register_data_set ($name, $data);
243 }
244 elsif ((TYPE_DATASET != $type) && (! ref $data)) {
245 my $pkg = scalar caller;
247 my %p : shared;
249 if ($data !~ m/^$pkg\:\:/) {
250 $data = $pkg . "::" . $data;
251 }
253 %p = (
254 wait_time => $interval_g,
255 wait_left => 0,
256 cb_name => $data,
257 );
259 lock @plugins;
260 $plugins[$type]->{$name} = \%p;
261 }
262 else {
263 ERROR ("Collectd::plugin_register: Invalid data.");
264 return;
265 }
266 return 1;
267 }
269 sub plugin_unregister {
270 my $type = shift;
271 my $name = shift;
273 DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\"");
275 if (! ((defined $type) && (defined $name))) {
276 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
277 return;
278 }
280 if (TYPE_DATASET == $type) {
281 return plugin_unregister_data_set ($name);
282 }
283 elsif (defined $plugins[$type]) {
284 lock @plugins;
285 delete $plugins[$type]->{$name};
286 }
287 else {
288 ERROR ("Collectd::plugin_unregister: Invalid type.");
289 return;
290 }
291 }
293 1;
295 # vim: set sw=4 ts=4 tw=78 noexpandtab :