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