bindings/perl/Collectd.pm

   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>
  19
  20 package Collectd;
  21
  22 use strict;
  23 use warnings;
  24
  25 use Config;
  26
  27 BEGIN {
  28         if (! $Config{'useithreads'}) {
  29                 die "Perl does not support ithreads!";
  30         }
  31 }
  32
  33 require Exporter;
  34
  35 our @ISA = qw( Exporter );
  36
  37 our %EXPORT_TAGS = (
  38         'plugin' => [ qw(
  39                         plugin_register
  40                         plugin_unregister
  41                         plugin_dispatch_values
  42                         plugin_log
  43         ) ],
  44         'types' => [ qw(
  45                         TYPE_INIT
  46                         TYPE_READ
  47                         TYPE_WRITE
  48                         TYPE_SHUTDOWN
  49                         TYPE_LOG
  50                         TYPE_DATASET
  51         ) ],
  52         'ds_types' => [ qw(
  53                         DS_TYPE_COUNTER
  54                         DS_TYPE_GAUGE
  55         ) ],
  56         'log' => [ qw(
  57                         ERROR
  58                         WARNING
  59                         NOTICE
  60                         INFO
  61                         DEBUG
  62                         LOG_ERR
  63                         LOG_WARNING
  64                         LOG_NOTICE
  65                         LOG_INFO
  66                         LOG_DEBUG
  67         ) ],
  68 );
  69
  70 {
  71         my %seen;
  72         push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
  73                 foreach keys %EXPORT_TAGS;
  74 }
  75
  76 Exporter::export_ok_tags ('all');
  77
  78 my @plugins  = ();
  79
  80 my %types = (
  81         TYPE_INIT,     "init",
  82         TYPE_READ,     "read",
  83         TYPE_WRITE,    "write",
  84         TYPE_SHUTDOWN, "shutdown",
  85         TYPE_LOG,      "log"
  86 );
  87
  88 foreach my $type (keys %types) {
  89         $plugins[$type] = {};
  90 }
  91
  92 sub _log {
  93         my $caller = shift;
  94         my $lvl    = shift;
  95         my $msg    = shift;
  96
  97         if ("Collectd" eq $caller) {
  98                 $msg = "perl: $msg";
  99         }
 100         return plugin_log ($lvl, $msg);
 101 }
 102
 103 sub ERROR   { _log (scalar caller, LOG_ERR,     shift); }
 104 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
 105 sub NOTICE  { _log (scalar caller, LOG_NOTICE,  shift); }
 106 sub INFO    { _log (scalar caller, LOG_INFO,    shift); }
 107 sub DEBUG   { _log (scalar caller, LOG_DEBUG,   shift); }
 108
 109 sub plugin_call_all {
 110         my $type = shift;
 111
 112         if (! defined $type) {
 113                 return;
 114         }
 115
 116         if (TYPE_LOG != $type) {
 117                 DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\"");
 118         }
 119
 120         if (! defined $plugins[$type]) {
 121                 ERROR ("Collectd::plugin_call: unknown type \"$type\"");
 122                 return;
 123         }
 124
 125         foreach my $plugin (keys %{$plugins[$type]}) {
 126                 my $p = $plugins[$type]->{$plugin};
 127
 128                 if ($p->{'wait_left'} > 0) {
 129                         # TODO: use interval_g
 130                         $p->{'wait_left'} -= 10;
 131                 }
 132
 133                 next if ($p->{'wait_left'} > 0);
 134
 135                 if (my $status = $p->{'code'}->(@_)) {
 136                         $p->{'wait_left'} = 0;
 137                         $p->{'wait_time'} = 10;
 138                 }
 139                 elsif (TYPE_READ == $type) {
 140                         $p->{'wait_left'} = $p->{'wait_time'};
 141                         $p->{'wait_time'} *= 2;
 142
 143                         if ($p->{'wait_time'} > 86400) {
 144                                 $p->{'wait_time'} = 86400;
 145                         }
 146
 147                         WARNING ("${plugin}->read() failed with status $status. "
 148                                 . "Will suspend it for $p->{'wait_left'} seconds.");
 149                 }
 150                 elsif (TYPE_INIT == $type) {
 151                         foreach my $type (keys %types) {
 152                                 plugin_unregister ($type, $plugin);
 153                         }
 154
 155                         ERROR ("${plugin}->init() failed with status $status. "
 156                                 . "Plugin will be disabled.");
 157                 }
 158                 elsif (TYPE_LOG != $type) {
 159                         WARNING ("${plugin}->$types{$type}() failed with status $status.");
 160                 }
 161         }
 162         return 1;
 163 }
 164
 165 # Collectd::plugin_register (type, name, data).
 166 #
 167 # type:
 168 #   init, read, write, shutdown, data set
 169 #
 170 # name:
 171 #   name of the plugin
 172 #
 173 # data:
 174 #   reference to the plugin's subroutine that does the work or the data set
 175 #   definition
 176 sub plugin_register {
 177         my $type = shift;
 178         my $name = shift;
 179         my $data = shift;
 180
 181         DEBUG ("Collectd::plugin_register: "
 182                 . "type = \"$type\", name = \"$name\", data = \"$data\"");
 183
 184         if (! ((defined $type) && (defined $name) && (defined $data))) {
 185                 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
 186                 return;
 187         }
 188
 189         if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)) {
 190                 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
 191                 return;
 192         }
 193
 194         if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
 195                 return plugin_register_data_set ($name, $data);
 196         }
 197         elsif ("CODE" eq ref $data) {
 198                 # TODO: make interval_g available at configuration time
 199                 $plugins[$type]->{$name} = {
 200                                 wait_time => 10,
 201                                 wait_left => 0,
 202                                 code      => $data,
 203                 };
 204         }
 205         else {
 206                 ERROR ("Collectd::plugin_register: Invalid data.");
 207                 return;
 208         }
 209         return 1;
 210 }
 211
 212 sub plugin_unregister {
 213         my $type = shift;
 214         my $name = shift;
 215
 216         DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\"");
 217
 218         if (! ((defined $type) && (defined $name))) {
 219                 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
 220                 return;
 221         }
 222
 223         if (TYPE_DATASET == $type) {
 224                 return plugin_unregister_data_set ($name);
 225         }
 226         elsif (defined $plugins[$type]) {
 227                 delete $plugins[$type]->{$name};
 228         }
 229         else {
 230                 ERROR ("Collectd::plugin_unregister: Invalid type.");
 231                 return;
 232         }
 233 }
 234
 235 1;
 236
 237 # vim: set sw=4 ts=4 tw=78 noexpandtab :
 238