bindings/perl/Collectd.pm

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