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