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