perl plugin: Fixed Collectd::plugin_call_all function name im DEBUG()/ERROR()
[collectd.git] / bindings / perl / lib / Collectd.pm
1 # collectd - Collectd.pm
2 # Copyright (C) 2007-2009  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>
19
20 package Collectd;
21
22 use strict;
23 use warnings;
24
25 use Config;
26
27 use threads;
28 use threads::shared;
29
30 BEGIN {
31         if (! $Config{'useithreads'}) {
32                 die "Perl does not support ithreads!";
33         }
34 }
35
36 require Exporter;
37
38 our @ISA = qw( Exporter );
39
40 our %EXPORT_TAGS = (
41         'plugin' => [ qw(
42                         plugin_register
43                         plugin_unregister
44                         plugin_dispatch_values
45                         plugin_get_interval
46                         plugin_write
47                         plugin_flush
48                         plugin_flush_one
49                         plugin_flush_all
50                         plugin_dispatch_notification
51                         plugin_log
52         ) ],
53         'types' => [ qw(
54                         TYPE_INIT
55                         TYPE_READ
56                         TYPE_WRITE
57                         TYPE_SHUTDOWN
58                         TYPE_LOG
59                         TYPE_NOTIF
60                         TYPE_FLUSH
61                         TYPE_CONFIG
62                         TYPE_DATASET
63         ) ],
64         'ds_types' => [ qw(
65                         DS_TYPE_COUNTER
66                         DS_TYPE_GAUGE
67         ) ],
68         'log' => [ qw(
69                         ERROR
70                         WARNING
71                         NOTICE
72                         INFO
73                         DEBUG
74                         LOG_ERR
75                         LOG_WARNING
76                         LOG_NOTICE
77                         LOG_INFO
78                         LOG_DEBUG
79         ) ],
80         'filter_chain' => [ qw(
81                         fc_register
82                         FC_MATCH_NO_MATCH
83                         FC_MATCH_MATCHES
84                         FC_TARGET_CONTINUE
85                         FC_TARGET_STOP
86                         FC_TARGET_RETURN
87         ) ],
88         'fc_types' => [ qw(
89                         FC_MATCH
90                         FC_TARGET
91         ) ],
92         'notif' => [ qw(
93                         NOTIF_FAILURE
94                         NOTIF_WARNING
95                         NOTIF_OKAY
96         ) ],
97         'globals' => [ qw(
98                         $hostname_g
99                         $interval_g
100         ) ],
101 );
102
103 {
104         my %seen;
105         push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
106                 foreach keys %EXPORT_TAGS;
107 }
108
109 # global variables
110 our $hostname_g;
111 our $interval_g;
112
113 Exporter::export_ok_tags ('all');
114
115 my @plugins : shared = ();
116 my @fc_plugins : shared = ();
117 my %cf_callbacks : shared = ();
118
119 my %types = (
120         TYPE_CONFIG,   "config",
121         TYPE_INIT,     "init",
122         TYPE_READ,     "read",
123         TYPE_WRITE,    "write",
124         TYPE_SHUTDOWN, "shutdown",
125         TYPE_LOG,      "log",
126         TYPE_NOTIF,    "notify",
127         TYPE_FLUSH,    "flush"
128 );
129
130 my %fc_types = (
131         FC_MATCH,  "match",
132         FC_TARGET, "target"
133 );
134
135 my %fc_exec_names = (
136         FC_MATCH,  "match",
137         FC_TARGET, "invoke"
138 );
139
140 my %fc_cb_types = (
141         FC_CB_EXEC, "exec",
142         FC_CB_CREATE, "create",
143         FC_CB_DESTROY, "destroy"
144 );
145
146 foreach my $type (keys %types) {
147         $plugins[$type] = &share ({});
148 }
149
150 foreach my $type (keys %fc_types) {
151         $fc_plugins[$type] = &share ({});
152 }
153
154 sub _log {
155         my $caller = shift;
156         my $lvl    = shift;
157         my $msg    = shift;
158
159         if ("Collectd" eq $caller) {
160                 $msg = "perl: $msg";
161         }
162         return plugin_log ($lvl, $msg);
163 }
164
165 sub ERROR   { _log (scalar caller, LOG_ERR,     shift); }
166 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
167 sub NOTICE  { _log (scalar caller, LOG_NOTICE,  shift); }
168 sub INFO    { _log (scalar caller, LOG_INFO,    shift); }
169 sub DEBUG   { _log (scalar caller, LOG_DEBUG,   shift); }
170
171 sub plugin_call_all {
172         my $type = shift;
173
174         my %plugins;
175
176         our $cb_name = undef;
177
178         if (! defined $type) {
179                 return;
180         }
181
182         if (TYPE_LOG != $type) {
183                 DEBUG ("Collectd::plugin_call_all: type = \"$type\" ("
184                         . $types{$type} . "), args=\""
185                         . join(', ', map { defined($_) ? $_ : '<undef>' } @_) . "\"");
186         }
187
188         if (! defined $plugins[$type]) {
189                 ERROR ("Collectd::plugin_call_all: unknown type \"$type\"");
190                 return;
191         }
192
193         {
194                 lock %{$plugins[$type]};
195                 %plugins = %{$plugins[$type]};
196         }
197
198         foreach my $plugin (keys %plugins) {
199                 $cb_name = $plugins{$plugin};
200                 my $status = call_by_name (@_);
201
202                 if (! $status) {
203                         my $err = undef;
204
205                         if ($@) {
206                                 $err = $@;
207                         }
208                         else {
209                                 $err = "callback returned false";
210                         }
211
212                         if (TYPE_LOG != $type) {
213                                 ERROR ("Execution of callback \"$cb_name\" failed: $err");
214                         }
215
216                         $status = 0;
217                 }
218
219                 if ($status) {
220                         #NOOP
221                 }
222                 elsif (TYPE_INIT == $type) {
223                         ERROR ("${plugin}->init() failed with status $status. "
224                                 . "Plugin will be disabled.");
225
226                         foreach my $type (keys %types) {
227                                 plugin_unregister ($type, $plugin);
228                         }
229                 }
230                 elsif (TYPE_LOG != $type) {
231                         WARNING ("${plugin}->$types{$type}() failed with status $status.");
232                 }
233         }
234         return 1;
235 }
236
237 # Collectd::plugin_register (type, name, data).
238 #
239 # type:
240 #   init, read, write, shutdown, data set
241 #
242 # name:
243 #   name of the plugin
244 #
245 # data:
246 #   reference to the plugin's subroutine that does the work or the data set
247 #   definition
248 sub plugin_register {
249         my $type = shift;
250         my $name = shift;
251         my $data = shift;
252
253         DEBUG ("Collectd::plugin_register: "
254                 . "type = \"$type\" (" . $types{$type}
255                 . "), name = \"$name\", data = \"$data\"");
256
257         if (! ((defined $type) && (defined $name) && (defined $data))) {
258                 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
259                 return;
260         }
261
262         if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)
263                         && (TYPE_CONFIG != $type)) {
264                 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
265                 return;
266         }
267
268         if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
269                 return plugin_register_data_set ($name, $data);
270         }
271         elsif ((TYPE_CONFIG == $type) && (! ref $data)) {
272                 my $pkg = scalar caller;
273
274                 if ($data !~ m/^$pkg\:\:/) {
275                         $data = $pkg . "::" . $data;
276                 }
277
278                 lock %cf_callbacks;
279                 $cf_callbacks{$name} = $data;
280         }
281         elsif ((TYPE_DATASET != $type) && (! ref $data)) {
282                 my $pkg = scalar caller;
283                 if ($data !~ m/^$pkg\:\:/) {
284                         $data = $pkg . "::" . $data;
285                 }
286                 if (TYPE_READ == $type) {
287                         return plugin_register_read($name, $data);
288                 }
289                 if (TYPE_WRITE == $type) {
290                         return plugin_register_write($name, $data);
291                 }
292                 if (TYPE_LOG == $type) {
293                         return plugin_register_log($name, $data);
294                 }
295                 if (TYPE_NOTIF == $type) {
296                         return plugin_register_notification($name, $data);
297                 }
298                 if (TYPE_FLUSH == $type) {
299                         return plugin_register_flush($name, $data);
300                 }
301                 lock %{$plugins[$type]};
302                 $plugins[$type]->{$name} = $data;
303         }
304         else {
305                 ERROR ("Collectd::plugin_register: Invalid data.");
306                 return;
307         }
308         return 1;
309 }
310
311 sub plugin_unregister {
312         my $type = shift;
313         my $name = shift;
314
315         DEBUG ("Collectd::plugin_unregister: type = \"$type\" ("
316                 . $types{$type} . "), name = \"$name\"");
317
318         if (! ((defined $type) && (defined $name))) {
319                 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
320                 return;
321         }
322
323         if (TYPE_DATASET == $type) {
324                 return plugin_unregister_data_set ($name);
325         }
326         elsif (TYPE_CONFIG == $type) {
327                 lock %cf_callbacks;
328                 delete $cf_callbacks{$name};
329         }
330         elsif (TYPE_READ == $type) {
331                 return plugin_unregister_read ($name);
332         }
333         elsif (TYPE_WRITE == $type) {
334                 return plugin_unregister_write($name);
335         }
336         elsif (TYPE_LOG == $type) {
337                 return plugin_unregister_log ($name);
338         }
339         elsif (TYPE_NOTIF == $type) {
340                 return plugin_unregister_notification($name);
341         }
342         elsif (TYPE_FLUSH == $type) {
343                 return plugin_unregister_flush($name);
344         }
345         elsif (defined $plugins[$type]) {
346                 lock %{$plugins[$type]};
347                 delete $plugins[$type]->{$name};
348         }
349         else {
350                 ERROR ("Collectd::plugin_unregister: Invalid type.");
351                 return;
352         }
353 }
354
355 sub plugin_write {
356         my %args = @_;
357
358         my @plugins    = ();
359         my @datasets   = ();
360         my @valuelists = ();
361
362         if (! defined $args{'valuelists'}) {
363                 ERROR ("Collectd::plugin_write: Missing 'valuelists' argument.");
364                 return;
365         }
366
367         DEBUG ("Collectd::plugin_write:"
368                 . (defined ($args{'plugins'}) ? " plugins = $args{'plugins'}" : "")
369                 . (defined ($args{'datasets'}) ? " datasets = $args{'datasets'}" : "")
370                 . " valueslists = $args{'valuelists'}");
371
372         if (defined ($args{'plugins'})) {
373                 if ("ARRAY" eq ref ($args{'plugins'})) {
374                         @plugins = @{$args{'plugins'}};
375                 }
376                 else {
377                         @plugins = ($args{'plugins'});
378                 }
379         }
380         else {
381                 @plugins = (undef);
382         }
383
384         if ("ARRAY" eq ref ($args{'valuelists'})) {
385                 @valuelists = @{$args{'valuelists'}};
386         }
387         else {
388                 @valuelists = ($args{'valuelists'});
389         }
390
391         if (defined ($args{'datasets'})) {
392                 if ("ARRAY" eq ref ($args{'datasets'})) {
393                         @datasets = @{$args{'datasets'}};
394                 }
395                 else {
396                         @datasets = ($args{'datasets'});
397                 }
398         }
399         else {
400                 @datasets = (undef) x scalar (@valuelists);
401         }
402
403         if ($#datasets != $#valuelists) {
404                 ERROR ("Collectd::plugin_write: Invalid number of datasets.");
405                 return;
406         }
407
408         foreach my $plugin (@plugins) {
409                 for (my $i = 0; $i < scalar (@valuelists); ++$i) {
410                         _plugin_write ($plugin, $datasets[$i], $valuelists[$i]);
411                 }
412         }
413 }
414
415 sub plugin_flush {
416         my %args = @_;
417
418         my $timeout = -1;
419         my @plugins = ();
420         my @ids     = ();
421
422         DEBUG ("Collectd::plugin_flush:"
423                 . (defined ($args{'timeout'}) ? " timeout = $args{'timeout'}" : "")
424                 . (defined ($args{'plugins'}) ? " plugins = $args{'plugins'}" : "")
425                 . (defined ($args{'identifiers'})
426                         ? " identifiers = $args{'identifiers'}" : ""));
427
428         if (defined ($args{'timeout'}) && ($args{'timeout'} > 0)) {
429                 $timeout = $args{'timeout'};
430         }
431
432         if (defined ($args{'plugins'})) {
433                 if ("ARRAY" eq ref ($args{'plugins'})) {
434                         @plugins = @{$args{'plugins'}};
435                 }
436                 else {
437                         @plugins = ($args{'plugins'});
438                 }
439         }
440         else {
441                 @plugins = (undef);
442         }
443
444         if (defined ($args{'identifiers'})) {
445                 if ("ARRAY" eq ref ($args{'identifiers'})) {
446                         @ids = @{$args{'identifiers'}};
447                 }
448                 else {
449                         @ids = ($args{'identifiers'});
450                 }
451         }
452         else {
453                 @ids = (undef);
454         }
455
456         foreach my $plugin (@plugins) {
457                 foreach my $id (@ids) {
458                         _plugin_flush($plugin, $timeout, $id);
459                 }
460         }
461 }
462
463 sub fc_call {
464         my $type    = shift;
465         my $name    = shift;
466         my $cb_type = shift;
467
468         my %proc;
469
470         our $cb_name = undef;
471         my  $status;
472
473         if (! ((defined $type) && (defined $name) && (defined $cb_type))) {
474                 ERROR ("Usage: Collectd::fc_call(type, name, cb_type, ...)");
475                 return;
476         }
477
478         if (! defined $fc_plugins[$type]) {
479                 ERROR ("Collectd::fc_call: Invalid type \"$type\"");
480                 return;
481         }
482
483         if (! defined $fc_plugins[$type]->{$name}) {
484                 ERROR ("Collectd::fc_call: Unknown "
485                         . ($type == FC_MATCH ? "match" : "target")
486                         . " \"$name\"");
487                 return;
488         }
489
490         DEBUG ("Collectd::fc_call: "
491                 . "type = \"$type\" (" . $fc_types{$type}
492                 . "), name = \"$name\", cb_type = \"$cb_type\" ("
493                 . $fc_cb_types{$cb_type} . ")");
494
495         {
496                 lock %{$fc_plugins[$type]};
497                 %proc = %{$fc_plugins[$type]->{$name}};
498         }
499
500         if (FC_CB_EXEC == $cb_type) {
501                 $cb_name = $proc{$fc_exec_names{$type}};
502         }
503         elsif (FC_CB_CREATE == $cb_type) {
504                 if (defined $proc{'create'}) {
505                         $cb_name = $proc{'create'};
506                 }
507                 else {
508                         return 1;
509                 }
510         }
511         elsif (FC_CB_DESTROY == $cb_type) {
512                 if (defined $proc{'destroy'}) {
513                         $cb_name = $proc{'destroy'};
514                 }
515                 else {
516                         return 1;
517                 }
518         }
519
520         $status = call_by_name (@_);
521
522         if ($status < 0) {
523                 my $err = undef;
524
525                 if ($@) {
526                         $err = $@;
527                 }
528                 else {
529                         $err = "callback returned false";
530                 }
531
532                 ERROR ("Execution of fc callback \"$cb_name\" failed: $err");
533                 return;
534         }
535         return $status;
536 }
537
538 sub fc_register {
539         my $type = shift;
540         my $name = shift;
541         my $proc = shift;
542
543         my %fc : shared;
544
545         DEBUG ("Collectd::fc_register: "
546                 . "type = \"$type\" (" . $fc_types{$type}
547                 . "), name = \"$name\", proc = \"$proc\"");
548
549         if (! ((defined $type) && (defined $name) && (defined $proc))) {
550                 ERROR ("Usage: Collectd::fc_register(type, name, proc)");
551                 return;
552         }
553
554         if (! defined $fc_plugins[$type]) {
555                 ERROR ("Collectd::fc_register: Invalid type \"$type\"");
556                 return;
557         }
558
559         if (("HASH" ne ref ($proc)) || (! defined $proc->{$fc_exec_names{$type}})
560                         || ("" ne ref ($proc->{$fc_exec_names{$type}}))) {
561                 ERROR ("Collectd::fc_register: Invalid proc.");
562                 return;
563         }
564
565         for my $p (qw( create destroy )) {
566                 if ((defined $proc->{$p}) && ("" ne ref ($proc->{$p}))) {
567                         ERROR ("Collectd::fc_register: Invalid proc.");
568                         return;
569                 }
570         }
571
572         %fc = %$proc;
573
574         foreach my $p (keys %fc) {
575                 my $pkg = scalar caller;
576
577                 if ($p !~ m/^(create|destroy|$fc_exec_names{$type})$/) {
578                         next;
579                 }
580
581                 if ($fc{$p} !~ m/^$pkg\:\:/) {
582                         $fc{$p} = $pkg . "::" . $fc{$p};
583                 }
584         }
585
586         lock %{$fc_plugins[$type]};
587         if (defined $fc_plugins[$type]->{$name}) {
588                 WARNING ("Collectd::fc_register: Overwriting previous "
589                         . "definition of match \"$name\".");
590         }
591
592         if (! _fc_register ($type, $name)) {
593                 ERROR ("Collectd::fc_register: Failed to register \"$name\".");
594                 return;
595         }
596
597         $fc_plugins[$type]->{$name} = \%fc;
598         return 1;
599 }
600
601 sub _plugin_dispatch_config {
602         my $plugin = shift;
603         my $config = shift;
604
605         our $cb_name = undef;
606
607         if (! (defined ($plugin) && defined ($config))) {
608                 return;
609         }
610
611         if (! defined $cf_callbacks{$plugin}) {
612                 WARNING ("Found a configuration for the \"$plugin\" plugin, but "
613                         . "the plugin isn't loaded or didn't register "
614                         . "a configuration callback.");
615                 return;
616         }
617
618         {
619                 lock %cf_callbacks;
620                 $cb_name = $cf_callbacks{$plugin};
621         }
622         call_by_name ($config);
623 }
624
625 1;
626
627 # vim: set sw=4 ts=4 tw=78 noexpandtab :
628