From: Sebastian Harl Date: Sun, 30 Sep 2007 22:09:50 +0000 (+0200) Subject: perl plugin: Reimplemented plugin_{,un}register() in plain Perl. X-Git-Tag: collectd-4.2.0~50 X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=7f27b191564dc366eab17f1515fc183b24911dbf;p=collectd.git perl plugin: Reimplemented plugin_{,un}register() in plain Perl. As this involves only Perl data structures, it makes more sense to write the algorithms in plain Perl as well. I suppose the perl interpreter can do a better job optimizing the code :-) Signed-off-by: Sebastian Harl --- diff --git a/bindings/perl/Collectd.pm b/bindings/perl/Collectd.pm index 0c6c6c80..d5d9833c 100644 --- a/bindings/perl/Collectd.pm +++ b/bindings/perl/Collectd.pm @@ -24,27 +24,209 @@ use warnings; require Exporter; +# make all symbols available at compile time +BEGIN { our $VERSION = '4.1.2'; bootstrap Collectd $VERSION; } + our @ISA = qw( Exporter ); our %EXPORT_TAGS = ( - 'funcs' => [ qw( plugin_register plugin_unregister - plugin_dispatch_values plugin_log ) ], - 'types' => [ qw( TYPE_INIT TYPE_READ TYPE_WRITE TYPE_SHUTDOWN TYPE_LOG - TYPE_DATASET ) ], - 'ds_types' => [ qw( DS_TYPE_COUNTER DS_TYPE_GAUGE ) ], - 'log' => [ qw( LOG_ERR LOG_WARNING LOG_NOTICE LOG_INFO LOG_DEBUG ) ], + 'plugin' => [ qw( + plugin_register + plugin_unregister + plugin_dispatch_values + plugin_log + ) ], + 'types' => [ qw( + TYPE_INIT + TYPE_READ + TYPE_WRITE + TYPE_SHUTDOWN + TYPE_LOG + TYPE_DATASET + ) ], + 'ds_types' => [ qw( + DS_TYPE_COUNTER + DS_TYPE_GAUGE + ) ], + 'log' => [ qw( + ERROR + WARNING + NOTICE + INFO + DEBUG + LOG_ERR + LOG_WARNING + LOG_NOTICE + LOG_INFO + LOG_DEBUG + ) ], ); { my %seen; - push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS; } -Exporter::export_ok_tags('all'); +Exporter::export_ok_tags ('all'); + +my @plugins = (); +my @datasets = (); + +my %types = ( + TYPE_INIT, "init", + TYPE_READ, "read", + TYPE_WRITE, "write", + TYPE_SHUTDOWN, "shutdown", + TYPE_LOG, "log" +); + +foreach my $type (keys %types) { + $plugins[$type] = {}; +} + +sub _log { + my $caller = shift; + my $lvl = shift; + my $msg = shift; + + if ("Collectd" eq $caller) { + $msg = "perl: $msg"; + } + return plugin_log ($lvl, $msg); +} + +sub ERROR { _log (scalar caller, LOG_ERR, shift); } +sub WARNING { _log (scalar caller, LOG_WARNING, shift); } +sub NOTICE { _log (scalar caller, LOG_NOTICE, shift); } +sub INFO { _log (scalar caller, LOG_INFO, shift); } +sub DEBUG { _log (scalar caller, LOG_DEBUG, shift); } + +sub plugin_call_all { + my $type = shift; + + if (! defined $type) { + return; + } + + if (TYPE_LOG != $type) { + DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\""); + } + + if (! defined $plugins[$type]) { + ERROR ("Collectd::plugin_call: unknown type \"$type\""); + return; + } + + foreach my $plugin (keys %{$plugins[$type]}) { + my $p = $plugins[$type]->{$plugin}; + + if ($p->{'wait_left'} > 0) { + # TODO: use interval_g + $p->{'wait_left'} -= 10; + } + + next if ($p->{'wait_left'} > 0); + + if (my $status = $p->{'code'}->(@_)) { + $p->{'wait_left'} = 0; + $p->{'wait_time'} = 10; + } + elsif (TYPE_READ == $type) { + $p->{'wait_left'} = $p->{'wait_time'}; + $p->{'wait_time'} *= 2; + + if ($p->{'wait_time'} > 86400) { + $p->{'wait_time'} = 86400; + } + + WARNING ("${plugin}->read() failed with status $status. " + . "Will suspend it for $p->{'wait_left'} seconds."); + } + elsif (TYPE_INIT == $type) { + foreach my $type (keys %types) { + plugin_unregister ($type, $plugin); + } + + ERROR ("${plugin}->init() failed with status $status. " + . "Plugin will be disabled."); + } + elsif (TYPE_LOG != $type) { + WARNING ("${plugin}->$types{$type}() failed with status $status."); + } + } + return 1; +} + +# Collectd::plugin_register (type, name, data). +# +# type: +# init, read, write, shutdown, data set +# +# name: +# name of the plugin +# +# data: +# reference to the plugin's subroutine that does the work or the data set +# definition +sub plugin_register { + my $type = shift; + my $name = shift; + my $data = shift; + + DEBUG ("Collectd::plugin_register: " + . "type = \"$type\", name = \"$name\", data = \"$data\""); + + if (! ((defined $type) && (defined $name) && (defined $data))) { + ERROR ("Usage: Collectd::plugin_register (type, name, data)"); + return; + } + + if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)) { + ERROR ("Collectd::plugin_register: Invalid type \"$type\""); + return; + } + + if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) { + return plugin_register_data_set ($name, $data); + } + elsif ("CODE" eq ref $data) { + # TODO: make interval_g available at configuration time + $plugins[$type]->{$name} = { + wait_time => 10, + wait_left => 0, + code => $data, + }; + } + else { + ERROR ("Collectd::plugin_register: Invalid data."); + return; + } + return 1; +} + +sub plugin_unregister { + my $type = shift; + my $name = shift; + + DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\""); -bootstrap Collectd "4.1.2"; + if (! ((defined $type) && (defined $name))) { + ERROR ("Usage: Collectd::plugin_unregister (type, name)"); + return; + } + + if (TYPE_DATASET == $type) { + return plugin_unregister_data_set ($name); + } + elsif (defined $plugins[$type]) { + delete $plugins[$type]->{$name}; + } + else { + ERROR ("Collectd::plugin_unregister: Invalid type."); + return; + } +} 1; diff --git a/src/perl.c b/src/perl.c index fa8a8fc8..626b2873 100644 --- a/src/perl.c +++ b/src/perl.c @@ -61,8 +61,8 @@ /* this is defined in DynaLoader.a */ void boot_DynaLoader (PerlInterpreter *, CV *); -static XS (Collectd_plugin_register); -static XS (Collectd_plugin_unregister); +static XS (Collectd_plugin_register_ds); +static XS (Collectd_plugin_unregister_ds); static XS (Collectd_plugin_dispatch_values); static XS (Collectd_plugin_log); @@ -76,13 +76,6 @@ typedef struct { int *values; } ds_types_t; -typedef struct { - int wait_time; - int wait_left; - - SV *sub; -} pplugin_t; - /* * private variables @@ -104,8 +97,6 @@ static char **perl_argv = NULL; static char base_name[DATA_MAX_NAME_LEN] = ""; -static char *plugin_types[] = { "init", "read", "write", "shutdown" }; -static HV *plugins[PLUGIN_TYPES]; static HV *data_sets; static struct { @@ -113,10 +104,10 @@ static struct { XS ((*f)); } api[] = { - { "Collectd::plugin_register", Collectd_plugin_register }, - { "Collectd::plugin_unregister", Collectd_plugin_unregister }, - { "Collectd::plugin_dispatch_values", Collectd_plugin_dispatch_values }, - { "Collectd::plugin_log", Collectd_plugin_log }, + { "Collectd::plugin_register_data_set", Collectd_plugin_register_ds }, + { "Collectd::plugin_unregister_data_set", Collectd_plugin_unregister_ds }, + { "Collectd::plugin_dispatch_values", Collectd_plugin_dispatch_values }, + { "Collectd::plugin_log", Collectd_plugin_log }, { "", NULL } }; @@ -342,62 +333,6 @@ static char *get_module_name (char *buf, size_t buf_len, const char *module) { } /* char *get_module_name */ /* - * Add a new plugin with the given name. - */ -static int pplugin_register (int type, const char *name, SV *sub) -{ - pplugin_t *p = NULL; - - if ((type < 0) || (type >= PLUGIN_TYPES)) - return -1; - - if (NULL == name) - return -1; - - p = (pplugin_t *)smalloc (sizeof (pplugin_t)); - /* this happens during parsing of config file, - * thus interval_g is not set correctly */ - p->wait_time = 10; - p->wait_left = 0; - p->sub = Perl_newSVsv (perl, sub); - - if (NULL == Perl_hv_store (perl, plugins[type], name, strlen (name), - Perl_sv_setref_pv (perl, Perl_newSV (perl, 0), 0, p), 0)) { - log_debug ("pplugin_register: Failed to add plugin \"%s\" (\"%s\")", - name, SvPV_nolen (sub)); - Perl_sv_free (perl, p->sub); - sfree (p); - return -1; - } - return 0; -} /* static int pplugin_register (int, char *, SV *) */ - -/* - * Removes the plugin with the given name and frees any ressources. - */ -static int pplugin_unregister (int type, char *name) -{ - SV *tmp = NULL; - - if ((type < 0) || (type >= PLUGIN_TYPES)) - return -1; - - if (NULL == name) - return -1; - - /* freeing the allocated memory of the element itself (pplugin_t *) causes - * a segfault during perl_destruct () thus I assume perl somehow takes - * care of this... */ - - tmp = Perl_hv_delete (perl, plugins[type], name, strlen (name), 0); - if (NULL != tmp) { - pplugin_t *p = (pplugin_t *)SvIV ((SV *)SvRV (tmp)); - Perl_sv_free (perl, p->sub); - } - return 0; -} /* static int pplugin_unregister (char *) */ - -/* * Add a plugin's data set definition. */ static int pplugin_register_data_set (char *name, AV *dataset) @@ -563,13 +498,13 @@ static int pplugin_dispatch_values (char *name, HV *values) } /* static int pplugin_dispatch_values (char *, HV *) */ /* - * Call a plugin's working function. + * Call all working functions of the given type. */ -static int pplugin_call (int type, char *name, SV *sub, va_list ap) +static int pplugin_call_all (int type, ...) { int retvals = 0; - I32 xflags = G_NOARGS; + va_list ap; int ret = 0; dSP; @@ -577,11 +512,15 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) if ((type < 0) || (type >= PLUGIN_TYPES)) return -1; + va_start (ap, type); + ENTER; SAVETMPS; PUSHMARK (SP); + XPUSHs (sv_2mortal (Perl_newSViv (perl, (IV)type))); + if (PLUGIN_WRITE == type) { /* * $_[0] = $plugin_type; @@ -625,8 +564,6 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) XPUSHs (sv_2mortal (Perl_newSVpv (perl, ds->type, 0))); XPUSHs (sv_2mortal (Perl_newRV_noinc (perl, (SV *)pds))); XPUSHs (sv_2mortal (Perl_newRV_noinc (perl, (SV *)pvl))); - - xflags = 0; } else if (PLUGIN_LOG == type) { /* @@ -636,27 +573,14 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) */ XPUSHs (sv_2mortal (Perl_newSViv (perl, va_arg (ap, int)))); XPUSHs (sv_2mortal (Perl_newSVpv (perl, va_arg (ap, char *), 0))); - - xflags = 0; } PUTBACK; - /* prevent an endless loop */ - if (PLUGIN_LOG != type) - log_debug ("pplugin_call: executing %s::%s->%s()", - base_name, name, plugin_types[type]); - - retvals = Perl_call_sv (perl, sub, G_SCALAR | xflags); + retvals = Perl_call_pv (perl, "Collectd::plugin_call_all", G_SCALAR); SPAGAIN; - if (1 > retvals) { - if (PLUGIN_LOG != type) - log_warn ("pplugin_call: " - "%s::%s->%s() returned void - assuming true", - base_name, name, plugin_types[type]); - } - else { + if (0 < retvals) { SV *tmp = POPs; if (! SvTRUE (tmp)) ret = -1; @@ -665,73 +589,9 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) PUTBACK; FREETMPS; LEAVE; - return ret; -} /* static int pplugin_call (int, char *, SV *, va_list) */ - -/* - * Call all working functions of the given type. - */ -static int pplugin_call_all (int type, ...) -{ - SV *tmp = NULL; - - char *plugin; - I32 len; - - if ((type < 0) || (type >= PLUGIN_TYPES)) - return -1; - - if (0 == Perl_hv_iterinit (perl, plugins[type])) - return 0; - while (NULL != (tmp = Perl_hv_iternextsv (perl, plugins[type], - &plugin, &len))) { - pplugin_t *p; - va_list ap; - - int status; - - va_start (ap, type); - - p = (pplugin_t *)SvIV ((SV *)SvRV (tmp)); - - if (p->wait_left > 0) - p->wait_left -= interval_g; - - if (p->wait_left > 0) - continue; - - if (0 == (status = pplugin_call (type, plugin, p->sub, ap))) { - p->wait_left = 0; - p->wait_time = interval_g; - } - else if (PLUGIN_READ == type) { - p->wait_left = p->wait_time; - p->wait_time <<= 1; - - if (p->wait_time > 86400) - p->wait_time = 86400; - - log_warn ("%s->read() failed. Will suspend it for %i seconds.", - plugin, p->wait_left); - } - else if (PLUGIN_INIT == type) { - int i = 0; - - log_err ("%s->init() failed. Plugin will be disabled.", - plugin, status); - - for (i = 0; i < PLUGIN_TYPES; ++i) - pplugin_unregister (i, plugin); - } - else if (PLUGIN_LOG != type) { - log_warn ("%s->%s() failed with status %i.", - plugin, plugin_types[type], status); - } - - va_end (ap); - } - return 0; + va_end (ap); + return ret; } /* static int pplugin_call_all (int, ...) */ @@ -740,50 +600,38 @@ static int pplugin_call_all (int type, ...) */ /* - * Collectd::plugin_register (type, name, data). + * Collectd::plugin_register_data_set (type, dataset). * * type: - * init, read, write, shutdown, data set - * - * name: - * name of the plugin + * type of the dataset * - * data: - * reference to the plugin's subroutine that does the work or the data set - * definition + * dataset: + * dataset to be registered */ -static XS (Collectd_plugin_register) +static XS (Collectd_plugin_register_ds) { - int type = 0; SV *data = NULL; - - int ret = 0; + int ret = 0; dXSARGS; - if (3 != items) { - log_err ("Usage: Collectd::plugin_register(type, name, data)"); + if (2 != items) { + log_err ("Usage: Collectd::plugin_register_data_set(type, dataset)"); XSRETURN_EMPTY; } - log_debug ("Collectd::plugin_register: " - "type = \"%i\", name = \"%s\", \"%s\"", - (int)SvIV (ST (0)), SvPV_nolen (ST (1)), SvPV_nolen (ST (2))); + log_debug ("Collectd::plugin_register_data_set: " + "type = \"%s\", dataset = \"%s\"", + SvPV_nolen (ST (0)), SvPV_nolen (ST (1))); - type = (int)SvIV (ST (0)); - data = ST (2); + data = ST (1); - if ((type >= 0) && (type < PLUGIN_TYPES) - && SvROK (data) && (SVt_PVCV == SvTYPE (SvRV (data)))) { - ret = pplugin_register (type, SvPV_nolen (ST (1)), data); - } - else if ((type == PLUGIN_DATASET) - && SvROK (data) && (SVt_PVAV == SvTYPE (SvRV (data)))) { - ret = pplugin_register_data_set (SvPV_nolen (ST (1)), + if (SvROK (data) && (SVt_PVAV == SvTYPE (SvRV (data)))) { + ret = pplugin_register_data_set (SvPV_nolen (ST (0)), (AV *)SvRV (data)); } else { - log_err ("Collectd::plugin_register: Invalid data."); + log_err ("Collectd::plugin_register_data_set: Invalid data."); XSRETURN_EMPTY; } @@ -791,50 +639,31 @@ static XS (Collectd_plugin_register) XSRETURN_YES; else XSRETURN_EMPTY; -} /* static XS (Collectd_plugin_register) */ +} /* static XS (Collectd_plugin_register_ds) */ /* - * Collectd::plugin_unregister (type, name). + * Collectd::plugin_unregister_data_set (type). * * type: - * init, read, write, shutdown, data set - * - * name: - * name of the plugin + * type of the dataset */ -static XS (Collectd_plugin_unregister) +static XS (Collectd_plugin_unregister_ds) { - int type = 0; - int ret = 0; - dXSARGS; - if (2 != items) { - log_err ("Usage: Collectd::plugin_unregister(type, name)"); + if (1 != items) { + log_err ("Usage: Collectd::plugin_unregister_data_set(type)"); XSRETURN_EMPTY; } - log_debug ("Collectd::plugin_unregister: type = \"%i\", name = \"%s\"", - (int)SvIV (ST (0)), SvPV_nolen (ST (1))); - - type = (int)SvIV (ST (0)); - - if ((type >= 0) && (type < PLUGIN_TYPES)) { - ret = pplugin_unregister (type, SvPV_nolen (ST (1))); - } - else if (type == PLUGIN_DATASET) { - ret = pplugin_unregister_data_set (SvPV_nolen (ST (1))); - } - else { - log_err ("Collectd::plugin_unregister: Invalid type."); - XSRETURN_EMPTY; - } + log_debug ("Collectd::plugin_unregister_data_set: type = \"%s\"", + SvPV_nolen (ST (0))); - if (0 == ret) + if (0 == pplugin_unregister_data_set (SvPV_nolen (ST (1)))) XSRETURN_YES; else XSRETURN_EMPTY; -} /* static XS (Collectd_plugin_unregister) */ +} /* static XS (Collectd_plugin_register_ds) */ /* * Collectd::plugin_dispatch_values (name, values). @@ -898,8 +727,6 @@ static XS (Collectd_plugin_log) XSRETURN_EMPTY; } - log_debug ("Collectd::plugin_log: level = %i, message = \"%s\"", - SvIV (ST (0)), SvPV_nolen (ST (1))); plugin_log (SvIV (ST (0)), SvPV_nolen (ST (1))); XSRETURN_YES; } /* static XS (Collectd_plugin_log) */ @@ -1000,34 +827,21 @@ static void perl_log (int level, const char *msg) static int perl_shutdown (void) { - int i = 0; int ret = 0; - plugin_unregister_log ("perl"); plugin_unregister_config ("perl"); - plugin_unregister_init ("perl"); - plugin_unregister_read ("perl"); - plugin_unregister_write ("perl"); if (NULL == perl) return 0; + plugin_unregister_log ("perl"); + plugin_unregister_init ("perl"); + plugin_unregister_read ("perl"); + plugin_unregister_write ("perl"); + PERL_SET_CONTEXT (perl); ret = pplugin_call_all (PLUGIN_SHUTDOWN); - for (i = 0; i < PLUGIN_TYPES; ++i) { - if (0 < Perl_hv_iterinit (perl, plugins[i])) { - char *k = NULL; - I32 l = 0; - - while (NULL != Perl_hv_iternextsv (perl, plugins[i], &k, &l)) { - pplugin_unregister (i, k); - } - } - - Perl_hv_undef (perl, plugins[i]); - } - if (0 < Perl_hv_iterinit (perl, data_sets)) { char *k = NULL; I32 l = 0; @@ -1097,9 +911,6 @@ static int init_pi (int argc, char **argv) } perl_run (perl); - for (i = 0; i < PLUGIN_TYPES; ++i) - plugins[i] = Perl_newHV (perl); - data_sets = Perl_newHV (perl); plugin_register_log ("perl", perl_log); @@ -1127,7 +938,7 @@ static int perl_config (const char *key, const char *value) init_pi (perl_argc, perl_argv); - log_info ("perl_config: loading perl plugin \"%s\"", value); + log_debug ("perl_config: loading perl plugin \"%s\"", value); Perl_load_module (perl, PERL_LOADMOD_NOIMPORT, Perl_newSVpv (perl, module_name, strlen (module_name)), Nullsv);