1 # collectd - Collectd.pm
2 # Copyright (C) 2007, 2008 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_flush
46 plugin_flush_one
47 plugin_flush_all
48 plugin_dispatch_notification
49 plugin_log
50 ) ],
51 'types' => [ qw(
52 TYPE_INIT
53 TYPE_READ
54 TYPE_WRITE
55 TYPE_SHUTDOWN
56 TYPE_LOG
57 TYPE_NOTIF
58 TYPE_FLUSH
59 TYPE_DATASET
60 ) ],
61 'ds_types' => [ qw(
62 DS_TYPE_COUNTER
63 DS_TYPE_GAUGE
64 ) ],
65 'log' => [ qw(
66 ERROR
67 WARNING
68 NOTICE
69 INFO
70 DEBUG
71 LOG_ERR
72 LOG_WARNING
73 LOG_NOTICE
74 LOG_INFO
75 LOG_DEBUG
76 ) ],
77 'notif' => [ qw(
78 NOTIF_FAILURE
79 NOTIF_WARNING
80 NOTIF_OKAY
81 ) ],
82 'globals' => [ qw(
83 $hostname_g
84 $interval_g
85 ) ],
86 );
88 {
89 my %seen;
90 push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
91 foreach keys %EXPORT_TAGS;
92 }
94 # global variables
95 our $hostname_g;
96 our $interval_g;
98 Exporter::export_ok_tags ('all');
100 my @plugins : shared = ();
102 my %types = (
103 TYPE_INIT, "init",
104 TYPE_READ, "read",
105 TYPE_WRITE, "write",
106 TYPE_SHUTDOWN, "shutdown",
107 TYPE_LOG, "log",
108 TYPE_NOTIF, "notify",
109 TYPE_FLUSH, "flush"
110 );
112 foreach my $type (keys %types) {
113 $plugins[$type] = &share ({});
114 }
116 sub _log {
117 my $caller = shift;
118 my $lvl = shift;
119 my $msg = shift;
121 if ("Collectd" eq $caller) {
122 $msg = "perl: $msg";
123 }
124 return plugin_log ($lvl, $msg);
125 }
127 sub ERROR { _log (scalar caller, LOG_ERR, shift); }
128 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
129 sub NOTICE { _log (scalar caller, LOG_NOTICE, shift); }
130 sub INFO { _log (scalar caller, LOG_INFO, shift); }
131 sub DEBUG { _log (scalar caller, LOG_DEBUG, shift); }
133 sub plugin_call_all {
134 my $type = shift;
136 my %plugins;
138 our $cb_name = undef;
140 if (! defined $type) {
141 return;
142 }
144 if (TYPE_LOG != $type) {
145 DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\"");
146 }
148 if (! defined $plugins[$type]) {
149 ERROR ("Collectd::plugin_call: unknown type \"$type\"");
150 return;
151 }
153 {
154 lock %{$plugins[$type]};
155 %plugins = %{$plugins[$type]};
156 }
158 foreach my $plugin (keys %plugins) {
159 my $p = $plugins{$plugin};
161 my $status = 0;
163 if ($p->{'wait_left'} > 0) {
164 $p->{'wait_left'} -= $interval_g;
165 }
167 next if ($p->{'wait_left'} > 0);
169 $cb_name = $p->{'cb_name'};
170 $status = call_by_name (@_);
172 if (! $status) {
173 my $err = undef;
175 if ($@) {
176 $err = $@;
177 }
178 else {
179 $err = "callback returned false";
180 }
182 if (TYPE_LOG != $type) {
183 ERROR ("Execution of callback \"$cb_name\" failed: $err");
184 }
186 $status = 0;
187 }
189 if ($status) {
190 $p->{'wait_left'} = 0;
191 $p->{'wait_time'} = $interval_g;
192 }
193 elsif (TYPE_READ == $type) {
194 if ($p->{'wait_time'} < $interval_g) {
195 $p->{'wait_time'} = $interval_g;
196 }
198 $p->{'wait_left'} = $p->{'wait_time'};
199 $p->{'wait_time'} *= 2;
201 if ($p->{'wait_time'} > 86400) {
202 $p->{'wait_time'} = 86400;
203 }
205 WARNING ("${plugin}->read() failed with status $status. "
206 . "Will suspend it for $p->{'wait_left'} seconds.");
207 }
208 elsif (TYPE_INIT == $type) {
209 ERROR ("${plugin}->init() failed with status $status. "
210 . "Plugin will be disabled.");
212 foreach my $type (keys %types) {
213 plugin_unregister ($type, $plugin);
214 }
215 }
216 elsif (TYPE_LOG != $type) {
217 WARNING ("${plugin}->$types{$type}() failed with status $status.");
218 }
219 }
220 return 1;
221 }
223 # Collectd::plugin_register (type, name, data).
224 #
225 # type:
226 # init, read, write, shutdown, data set
227 #
228 # name:
229 # name of the plugin
230 #
231 # data:
232 # reference to the plugin's subroutine that does the work or the data set
233 # definition
234 sub plugin_register {
235 my $type = shift;
236 my $name = shift;
237 my $data = shift;
239 DEBUG ("Collectd::plugin_register: "
240 . "type = \"$type\", name = \"$name\", data = \"$data\"");
242 if (! ((defined $type) && (defined $name) && (defined $data))) {
243 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
244 return;
245 }
247 if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)) {
248 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
249 return;
250 }
252 if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
253 return plugin_register_data_set ($name, $data);
254 }
255 elsif ((TYPE_DATASET != $type) && (! ref $data)) {
256 my $pkg = scalar caller;
258 my %p : shared;
260 if ($data !~ m/^$pkg\:\:/) {
261 $data = $pkg . "::" . $data;
262 }
264 %p = (
265 wait_time => $interval_g,
266 wait_left => 0,
267 cb_name => $data,
268 );
270 lock %{$plugins[$type]};
271 $plugins[$type]->{$name} = \%p;
272 }
273 else {
274 ERROR ("Collectd::plugin_register: Invalid data.");
275 return;
276 }
277 return 1;
278 }
280 sub plugin_unregister {
281 my $type = shift;
282 my $name = shift;
284 DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\"");
286 if (! ((defined $type) && (defined $name))) {
287 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
288 return;
289 }
291 if (TYPE_DATASET == $type) {
292 return plugin_unregister_data_set ($name);
293 }
294 elsif (defined $plugins[$type]) {
295 lock %{$plugins[$type]};
296 delete $plugins[$type]->{$name};
297 }
298 else {
299 ERROR ("Collectd::plugin_unregister: Invalid type.");
300 return;
301 }
302 }
304 sub plugin_flush {
305 my %args = @_;
307 my $timeout = -1;
309 DEBUG ("Collectd::plugin_flush:"
310 . (defined ($args{'timeout'}) ? " timeout = $args{'timeout'}" : "")
311 . (defined ($args{'plugins'}) ? " plugins = $args{'plugins'}" : ""));
313 if (defined ($args{'timeout'}) && ($args{'timeout'} > 0)) {
314 $timeout = $args{'timeout'};
315 }
317 if (! defined $args{'plugins'}) {
318 plugin_flush_all ($timeout);
319 }
320 else {
321 if ("ARRAY" eq ref ($args{'plugins'})) {
322 foreach my $plugin (@{$args{'plugins'}}) {
323 plugin_flush_one ($timeout, $plugin);
324 }
325 }
326 else {
327 plugin_flush_one ($timeout, $args{'plugins'});
328 }
329 }
330 }
332 1;
334 # vim: set sw=4 ts=4 tw=78 noexpandtab :