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 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_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 );
  72
  73 {
  74         my %seen;
  75         push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
  76                 foreach keys %EXPORT_TAGS;
  77 }
  78
  79 Exporter::export_ok_tags ('all');
  80
  81 my @plugins : shared = ();
  82
  83 my %types = (
  84         TYPE_INIT,     "init",
  85         TYPE_READ,     "read",
  86         TYPE_WRITE,    "write",
  87         TYPE_SHUTDOWN, "shutdown",
  88         TYPE_LOG,      "log"
  89 );
  90
  91 foreach my $type (keys %types) {
  92         $plugins[$type] = &share ({});
  93 }
  94
  95 sub _log {
  96         my $caller = shift;
  97         my $lvl    = shift;
  98         my $msg    = shift;
  99
 100         if ("Collectd" eq $caller) {
 101                 $msg = "perl: $msg";
 102         }
 103         return plugin_log ($lvl, $msg);
 104 }
 105
 106 sub ERROR   { _log (scalar caller, LOG_ERR,     shift); }
 107 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
 108 sub NOTICE  { _log (scalar caller, LOG_NOTICE,  shift); }
 109 sub INFO    { _log (scalar caller, LOG_INFO,    shift); }
 110 sub DEBUG   { _log (scalar caller, LOG_DEBUG,   shift); }
 111
 112 sub plugin_call_all {
 113         my $type = shift;
 114
 115         our $cb_name = undef;
 116
 117         if (! defined $type) {
 118                 return;
 119         }
 120
 121         if (TYPE_LOG != $type) {
 122                 DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\"");
 123         }
 124
 125         if (! defined $plugins[$type]) {
 126                 ERROR ("Collectd::plugin_call: unknown type \"$type\"");
 127                 return;
 128         }
 129
 130         lock @plugins;
 131         foreach my $plugin (keys %{$plugins[$type]}) {
 132                 my $p = $plugins[$type]->{$plugin};
 133
 134                 my $status = 0;
 135
 136                 if ($p->{'wait_left'} > 0) {
 137                         # TODO: use interval_g
 138                         $p->{'wait_left'} -= 10;
 139                 }
 140
 141                 next if ($p->{'wait_left'} > 0);
 142
 143                 $cb_name = $p->{'cb_name'};
 144                 $status = call_by_name (@_);
 145
 146                 if (! defined $status) {
 147                         if (TYPE_LOG != $type) {
 148                                 ERROR ("Could not execute callback \"$cb_name\": $@");
 149                         }
 150
 151                         next;
 152                 }
 153
 154                 if ($status) {
 155                         $p->{'wait_left'} = 0;
 156                         $p->{'wait_time'} = 10;
 157                 }
 158                 elsif (TYPE_READ == $type) {
 159                         $p->{'wait_left'} = $p->{'wait_time'};
 160                         $p->{'wait_time'} *= 2;
 161
 162                         if ($p->{'wait_time'} > 86400) {
 163                                 $p->{'wait_time'} = 86400;
 164                         }
 165
 166                         WARNING ("${plugin}->read() failed with status $status. "
 167                                 . "Will suspend it for $p->{'wait_left'} seconds.");
 168                 }
 169                 elsif (TYPE_INIT == $type) {
 170                         foreach my $type (keys %types) {
 171                                 plugin_unregister ($type, $plugin);
 172                         }
 173
 174                         ERROR ("${plugin}->init() failed with status $status. "
 175                                 . "Plugin will be disabled.");
 176                 }
 177                 elsif (TYPE_LOG != $type) {
 178                         WARNING ("${plugin}->$types{$type}() failed with status $status.");
 179                 }
 180         }
 181         return 1;
 182 }
 183
 184 # Collectd::plugin_register (type, name, data).
 185 #
 186 # type:
 187 #   init, read, write, shutdown, data set
 188 #
 189 # name:
 190 #   name of the plugin
 191 #
 192 # data:
 193 #   reference to the plugin's subroutine that does the work or the data set
 194 #   definition
 195 sub plugin_register {
 196         my $type = shift;
 197         my $name = shift;
 198         my $data = shift;
 199
 200         DEBUG ("Collectd::plugin_register: "
 201                 . "type = \"$type\", name = \"$name\", data = \"$data\"");
 202
 203         if (! ((defined $type) && (defined $name) && (defined $data))) {
 204                 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
 205                 return;
 206         }
 207
 208         if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)) {
 209                 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
 210                 return;
 211         }
 212
 213         if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
 214                 return plugin_register_data_set ($name, $data);
 215         }
 216         elsif ((TYPE_DATASET != $type) && (! ref $data)) {
 217                 my $pkg = scalar caller;
 218
 219                 my %p : shared;
 220
 221                 if ($data !~ m/^$pkg/) {
 222                         $data = $pkg . "::" . $data;
 223                 }
 224
 225                 # TODO: make interval_g available at configuration time
 226                 %p = (
 227                         wait_time => 10,
 228                         wait_left => 0,
 229                         cb_name   => $data,
 230                 );
 231
 232                 lock @plugins;
 233                 $plugins[$type]->{$name} = \%p;
 234         }
 235         else {
 236                 ERROR ("Collectd::plugin_register: Invalid data.");
 237                 return;
 238         }
 239         return 1;
 240 }
 241
 242 sub plugin_unregister {
 243         my $type = shift;
 244         my $name = shift;
 245
 246         DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\"");
 247
 248         if (! ((defined $type) && (defined $name))) {
 249                 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
 250                 return;
 251         }
 252
 253         if (TYPE_DATASET == $type) {
 254                 return plugin_unregister_data_set ($name);
 255         }
 256         elsif (defined $plugins[$type]) {
 257                 lock @plugins;
 258                 delete $plugins[$type]->{$name};
 259         }
 260         else {
 261                 ERROR ("Collectd::plugin_unregister: Invalid type.");
 262                 return;
 263         }
 264 }
 265
 266 1;
 267
 268 # vim: set sw=4 ts=4 tw=78 noexpandtab :
 269