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_log
46 ) ],
47 'types' => [ qw(
48 TYPE_INIT
49 TYPE_READ
50 TYPE_WRITE
51 TYPE_SHUTDOWN
52 TYPE_LOG
53 TYPE_DATASET
54 ) ],
55 'ds_types' => [ qw(
56 DS_TYPE_COUNTER
57 DS_TYPE_GAUGE
58 ) ],
59 'log' => [ qw(
60 ERROR
61 WARNING
62 NOTICE
63 INFO
64 DEBUG
65 LOG_ERR
66 LOG_WARNING
67 LOG_NOTICE
68 LOG_INFO
69 LOG_DEBUG
70 ) ],
71 'globals' => [ qw(
72 $hostname_g
73 $interval_g
74 ) ],
75 );
77 {
78 my %seen;
79 push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
80 foreach keys %EXPORT_TAGS;
81 }
83 Exporter::export_ok_tags ('all');
85 my @plugins : shared = ();
87 my %types = (
88 TYPE_INIT, "init",
89 TYPE_READ, "read",
90 TYPE_WRITE, "write",
91 TYPE_SHUTDOWN, "shutdown",
92 TYPE_LOG, "log"
93 );
95 foreach my $type (keys %types) {
96 $plugins[$type] = &share ({});
97 }
99 sub _log {
100 my $caller = shift;
101 my $lvl = shift;
102 my $msg = shift;
104 if ("Collectd" eq $caller) {
105 $msg = "perl: $msg";
106 }
107 return plugin_log ($lvl, $msg);
108 }
110 sub ERROR { _log (scalar caller, LOG_ERR, shift); }
111 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
112 sub NOTICE { _log (scalar caller, LOG_NOTICE, shift); }
113 sub INFO { _log (scalar caller, LOG_INFO, shift); }
114 sub DEBUG { _log (scalar caller, LOG_DEBUG, shift); }
116 sub plugin_call_all {
117 my $type = shift;
119 our $cb_name = undef;
121 if (! defined $type) {
122 return;
123 }
125 if (TYPE_LOG != $type) {
126 DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\"");
127 }
129 if (! defined $plugins[$type]) {
130 ERROR ("Collectd::plugin_call: unknown type \"$type\"");
131 return;
132 }
134 lock @plugins;
135 foreach my $plugin (keys %{$plugins[$type]}) {
136 my $p = $plugins[$type]->{$plugin};
138 my $status = 0;
140 if ($p->{'wait_left'} > 0) {
141 # TODO: use interval_g
142 $p->{'wait_left'} -= 10;
143 }
145 next if ($p->{'wait_left'} > 0);
147 $cb_name = $p->{'cb_name'};
148 $status = call_by_name (@_);
150 if (! $status) {
151 my $err = undef;
153 if ($@) {
154 $err = $@;
155 }
156 else {
157 $err = "callback returned false";
158 }
160 if (TYPE_LOG != $type) {
161 ERROR ("Execution of callback \"$cb_name\" failed: $err");
162 }
164 $status = 0;
165 }
167 if ($status) {
168 $p->{'wait_left'} = 0;
169 $p->{'wait_time'} = 10;
170 }
171 elsif (TYPE_READ == $type) {
172 WARNING ("${plugin}->read() failed with status $status. "
173 . "Will suspend it for $p->{'wait_left'} seconds.");
175 $p->{'wait_left'} = $p->{'wait_time'};
176 $p->{'wait_time'} *= 2;
178 if ($p->{'wait_time'} > 86400) {
179 $p->{'wait_time'} = 86400;
180 }
181 }
182 elsif (TYPE_INIT == $type) {
183 ERROR ("${plugin}->init() failed with status $status. "
184 . "Plugin will be disabled.");
186 foreach my $type (keys %types) {
187 plugin_unregister ($type, $plugin);
188 }
189 }
190 elsif (TYPE_LOG != $type) {
191 WARNING ("${plugin}->$types{$type}() failed with status $status.");
192 }
193 }
194 return 1;
195 }
197 # Collectd::plugin_register (type, name, data).
198 #
199 # type:
200 # init, read, write, shutdown, data set
201 #
202 # name:
203 # name of the plugin
204 #
205 # data:
206 # reference to the plugin's subroutine that does the work or the data set
207 # definition
208 sub plugin_register {
209 my $type = shift;
210 my $name = shift;
211 my $data = shift;
213 DEBUG ("Collectd::plugin_register: "
214 . "type = \"$type\", name = \"$name\", data = \"$data\"");
216 if (! ((defined $type) && (defined $name) && (defined $data))) {
217 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
218 return;
219 }
221 if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)) {
222 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
223 return;
224 }
226 if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
227 return plugin_register_data_set ($name, $data);
228 }
229 elsif ((TYPE_DATASET != $type) && (! ref $data)) {
230 my $pkg = scalar caller;
232 my %p : shared;
234 if ($data !~ m/^$pkg/) {
235 $data = $pkg . "::" . $data;
236 }
238 # TODO: make interval_g available at configuration time
239 %p = (
240 wait_time => 10,
241 wait_left => 0,
242 cb_name => $data,
243 );
245 lock @plugins;
246 $plugins[$type]->{$name} = \%p;
247 }
248 else {
249 ERROR ("Collectd::plugin_register: Invalid data.");
250 return;
251 }
252 return 1;
253 }
255 sub plugin_unregister {
256 my $type = shift;
257 my $name = shift;
259 DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\"");
261 if (! ((defined $type) && (defined $name))) {
262 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
263 return;
264 }
266 if (TYPE_DATASET == $type) {
267 return plugin_unregister_data_set ($name);
268 }
269 elsif (defined $plugins[$type]) {
270 lock @plugins;
271 delete $plugins[$type]->{$name};
272 }
273 else {
274 ERROR ("Collectd::plugin_unregister: Invalid type.");
275 return;
276 }
277 }
279 1;
281 # vim: set sw=4 ts=4 tw=78 noexpandtab :