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