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