#define log_warn(...) WARNING ("perl: " __VA_ARGS__)
#define log_err(...) ERROR ("perl: " __VA_ARGS__)
-
/* 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);
-
-/*
- * private data types
- */
-
-typedef struct {
- int len;
- int *values;
-} ds_types_t;
-
-typedef struct {
- int wait_time;
- int wait_left;
-
- SV *sub;
-} pplugin_t;
-
-
/*
* private variables
*/
-/* valid configuration file keys */
-static const char *config_keys[] =
-{
- "LoadPlugin",
- "BaseName",
- "IncludeDir"
-};
-static int config_keys_num = STATIC_ARRAY_SIZE (config_keys);
-
static PerlInterpreter *perl = NULL;
static int perl_argc = 0;
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 {
char name[64];
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 }
};
+struct {
+ char name[64];
+ int value;
+} constants[] =
+{
+ { "Collectd::TYPE_INIT", PLUGIN_INIT },
+ { "Collectd::TYPE_READ", PLUGIN_READ },
+ { "Collectd::TYPE_WRITE", PLUGIN_WRITE },
+ { "Collectd::TYPE_SHUTDOWN", PLUGIN_SHUTDOWN },
+ { "Collectd::TYPE_LOG", PLUGIN_LOG },
+ { "Collectd::TYPE_DATASET", PLUGIN_DATASET },
+ { "Collectd::DS_TYPE_COUNTER", DS_TYPE_COUNTER },
+ { "Collectd::DS_TYPE_GAUGE", DS_TYPE_GAUGE },
+ { "Collectd::LOG_ERR", LOG_ERR },
+ { "Collectd::LOG_WARNING", LOG_WARNING },
+ { "Collectd::LOG_NOTICE", LOG_NOTICE },
+ { "Collectd::LOG_INFO", LOG_INFO },
+ { "Collectd::LOG_DEBUG", LOG_DEBUG },
+ { "", 0 }
+};
/*
* Helper functions for data type conversion.
static int av2value (char *name, AV *array, value_t *value, int len)
{
- SV **tmp = NULL;
-
- ds_types_t *ds = NULL;
+ const data_set_t *ds;
int i = 0;
if (0 >= len)
return -1;
- tmp = Perl_hv_fetch (perl, data_sets, name, strlen (name), 0);
- if (NULL == tmp) {
- log_err ("av2value: No dataset for \"%s\".", name);
+ ds = plugin_get_ds (name);
+ if (NULL == ds) {
+ log_err ("av2value: Unknown dataset \"%s\"", name);
return -1;
}
- ds = (ds_types_t *)SvIV ((SV *)SvRV (*tmp));
- if (ds->len < len) {
+ if (ds->ds_num < len) {
log_warn ("av2value: Value length exceeds data set length.");
- len = ds->len;
+ len = ds->ds_num;
}
for (i = 0; i < len; ++i) {
SV **tmp = Perl_av_fetch (perl, array, i, 0);
if (NULL != tmp) {
- if (DS_TYPE_COUNTER == ds->values[i])
+ if (DS_TYPE_COUNTER == ds->ds[i].type)
value[i].counter = SvIV (*tmp);
else
value[i].gauge = SvNV (*tmp);
return 0;
} /* static int value2av (value_list_t *, data_set_t *, HV *) */
-
/*
* Internal functions.
*/
} /* 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)
data_source_t *ds = NULL;
data_set_t *set = NULL;
- ds_types_t *types = NULL;
-
if ((NULL == name) || (NULL == dataset))
return -1;
ds = (data_source_t *)smalloc ((len + 1) * sizeof (data_source_t));
set = (data_set_t *)smalloc (sizeof (data_set_t));
- types = (ds_types_t *)smalloc (sizeof (ds_types_t));
- types->len = len + 1;
- types->values = (int *)smalloc ((types->len) * sizeof (int));
-
for (i = 0; i <= len; ++i) {
SV **elem = Perl_av_fetch (perl, dataset, i, 0);
if (-1 == hv2data_source ((HV *)SvRV (*elem), &ds[i]))
return -1;
- types->values[i] = ds[i].type;
log_debug ("pplugin_register_data_set: "
"DS.name = \"%s\", DS.type = %i, DS.min = %f, DS.max = %f",
ds[i].name, ds[i].type, ds[i].min, ds[i].max);
}
- if (NULL == Perl_hv_store (perl, data_sets, name, strlen (name),
- Perl_sv_setref_pv (perl, Perl_newSV (perl, 0), 0, types), 0))
- return -1;
-
strncpy (set->type, name, DATA_MAX_NAME_LEN);
set->type[DATA_MAX_NAME_LEN - 1] = '\0';
*/
static int pplugin_unregister_data_set (char *name)
{
- SV *tmp = NULL;
-
if (NULL == name)
return 0;
-
- /* freeing the allocated memory of the element itself (ds_types_t *)
- * causes a segfault during perl_destruct () thus I assume perl somehow
- * takes care of this... */
-
- tmp = Perl_hv_delete (perl, data_sets, name, strlen (name), 0);
- if (NULL != tmp) {
- ds_types_t *ds = (ds_types_t *)SvIV ((SV *)SvRV (tmp));
- sfree (ds->values);
- }
return plugin_unregister_data_set (name);
} /* static int pplugin_unregister_data_set (char *) */
AV *array = (AV *)SvRV (*tmp);
int len = Perl_av_len (perl, array) + 1;
+ if (len <= 0)
+ return -1;
+
val = (value_t *)smalloc (len * sizeof (value_t));
list.values_len = av2value (name, (AV *)SvRV (*tmp), val, len);
} /* 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;
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;
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) {
/*
*/
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;
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, ...) */
-
/*
* Exported Perl API.
*/
/*
- * Collectd::plugin_register (type, name, data).
+ * Collectd::plugin_register_data_set (type, dataset).
*
* type:
- * init, read, write, shutdown, data set
+ * type of the dataset
*
- * name:
- * name of the plugin
- *
- * 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;
}
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));
+ log_debug ("Collectd::plugin_unregister_data_set: type = \"%s\"",
+ SvPV_nolen (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;
- }
-
- 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).
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) */
/*
- * Collectd::bootstrap ().
- */
-static XS (boot_Collectd)
-{
- HV *stash = NULL;
- char *file = __FILE__;
-
- struct {
- char name[64];
- SV *value;
- } consts[] =
- {
- { "Collectd::TYPE_INIT", Perl_newSViv (perl, PLUGIN_INIT) },
- { "Collectd::TYPE_READ", Perl_newSViv (perl, PLUGIN_READ) },
- { "Collectd::TYPE_WRITE", Perl_newSViv (perl, PLUGIN_WRITE) },
- { "Collectd::TYPE_SHUTDOWN", Perl_newSViv (perl, PLUGIN_SHUTDOWN) },
- { "Collectd::TYPE_LOG", Perl_newSViv (perl, PLUGIN_LOG) },
- { "Collectd::TYPE_DATASET", Perl_newSViv (perl, PLUGIN_DATASET) },
- { "Collectd::DS_TYPE_COUNTER", Perl_newSViv (perl, DS_TYPE_COUNTER) },
- { "Collectd::DS_TYPE_GAUGE", Perl_newSViv (perl, DS_TYPE_GAUGE) },
- { "Collectd::LOG_ERR", Perl_newSViv (perl, LOG_ERR) },
- { "Collectd::LOG_WARNING", Perl_newSViv (perl, LOG_WARNING) },
- { "Collectd::LOG_NOTICE", Perl_newSViv (perl, LOG_NOTICE) },
- { "Collectd::LOG_INFO", Perl_newSViv (perl, LOG_INFO) },
- { "Collectd::LOG_DEBUG", Perl_newSViv (perl, LOG_DEBUG) },
- { "", NULL }
- };
-
- int i = 0;
-
- dXSARGS;
-
- if ((1 > items) || (2 < items)) {
- log_err ("Usage: Collectd::bootstrap(name[, version])");
- XSRETURN_EMPTY;
- }
-
- XS_VERSION_BOOTCHECK;
-
- /* register API */
- for (i = 0; NULL != api[i].f; ++i)
- Perl_newXS (perl, api[i].name, api[i].f, file);
-
- stash = Perl_gv_stashpv (perl, "Collectd", 1);
-
- /* export "constants" */
- for (i = 0; NULL != consts[i].value; ++i)
- Perl_newCONSTSUB (perl, stash, consts[i].name, consts[i].value);
- XSRETURN_YES;
-} /* static XS (boot_Collectd) */
-
-
-/*
* Interface to collectd.
*/
static int perl_shutdown (void)
{
- int i = 0;
int ret = 0;
+ plugin_unregister_complex_config ("perl");
+
+ if (NULL == perl)
+ return 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;
-
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;
-
- while (NULL != Perl_hv_iternextsv (perl, data_sets, &k, &l)) {
- pplugin_unregister_data_set (k);
- }
- }
-
- Perl_hv_undef (perl, data_sets);
-
#if COLLECT_DEBUG
Perl_sv_report_used (perl);
#endif /* COLLECT_DEBUG */
return ret;
} /* static void perl_shutdown (void) */
+/* bootstrap the Collectd module */
static void xs_init (pTHX)
{
- char *file = __FILE__;
+ HV *stash = NULL;
+ char *file = __FILE__;
- dXSUB_SYS;
+ int i = 0;
- /* build the Collectd module into the perl interpreter */
- Perl_newXS (perl, "Collectd::bootstrap", boot_Collectd, file);
+ dXSUB_SYS;
/* enable usage of Perl modules using shared libraries */
Perl_newXS (perl, "DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+
+ /* register API */
+ for (i = 0; NULL != api[i].f; ++i)
+ Perl_newXS (perl, api[i].name, api[i].f, file);
+
+ stash = Perl_gv_stashpv (perl, "Collectd", 1);
+
+ /* export "constants" */
+ for (i = 0; '\0' != constants[i].name[0]; ++i)
+ Perl_newCONSTSUB (perl, stash, constants[i].name,
+ Perl_newSViv (perl, constants[i].value));
return;
} /* static void xs_init (pTHX) */
/* Initialize the global Perl interpreter. */
static int init_pi (int argc, char **argv)
{
- int i = 0;
-
if (NULL != perl)
return 0;
log_info ("Initializing Perl interpreter...");
#if COLLECT_DEBUG
- for (i = 0; i < argc; ++i)
- log_debug ("argv[%i] = \"%s\"", i, argv[i]);
+ {
+ int i = 0;
+
+ for (i = 0; i < argc; ++i)
+ log_debug ("argv[%i] = \"%s\"", i, argv[i]);
+ }
#endif /* COLLECT_DEBUG */
PERL_SYS_INIT3 (&argc, &argv, &environ);
log_err ("module_register: Unable to bootstrap Collectd.");
exit (1);
}
- perl_run (perl);
- for (i = 0; i < PLUGIN_TYPES; ++i)
- plugins[i] = Perl_newHV (perl);
+ /* Set $0 to "collectd" because perl_parse() has to set it to "-e". */
+ Perl_sv_setpv (perl, Perl_get_sv (perl, "0", 0), "collectd");
- data_sets = Perl_newHV (perl);
+ perl_run (perl);
plugin_register_log ("perl", perl_log);
plugin_register_init ("perl", perl_init);
return 0;
} /* static int init_pi (const char **, const int) */
-static int perl_config (const char *key, const char *value)
+/*
+ * LoadPlugin "<Plugin>"
+ */
+static int perl_config_loadplugin (oconfig_item_t *ci)
{
- log_debug ("perl_config: key = \"%s\", value=\"%s\"", key, value);
+ char module_name[DATA_MAX_NAME_LEN];
- if (0 == strcasecmp (key, "LoadPlugin")) {
- char module_name[DATA_MAX_NAME_LEN];
+ char *value = NULL;
- if (get_module_name (module_name, sizeof (module_name), value)
- == NULL) {
- log_err ("Invalid module name %s", value);
- return (1);
- } /* if (get_module_name == NULL) */
+ if ((0 != ci->children_num) || (1 != ci->values_num)
+ || (OCONFIG_TYPE_STRING != ci->values[0].type))
+ return 1;
- init_pi (perl_argc, perl_argv);
+ value = ci->values[0].value.string;
- log_info ("perl_config: loading perl plugin \"%s\"", value);
- Perl_load_module (perl, PERL_LOADMOD_NOIMPORT,
- Perl_newSVpv (perl, module_name, strlen (module_name)),
- Nullsv);
+ if (NULL == get_module_name (module_name, sizeof (module_name), value)) {
+ log_err ("Invalid module name %s", value);
+ return (1);
}
- else if (0 == strcasecmp (key, "BaseName")) {
- log_debug ("perl_config: Setting plugin basename to \"%s\"", value);
- strncpy (base_name, value, sizeof (base_name));
- base_name[sizeof (base_name) - 1] = '\0';
+
+ init_pi (perl_argc, perl_argv);
+
+ 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);
+ return 0;
+} /* static int perl_config_loadplugin (oconfig_item_it *) */
+
+/*
+ * BaseName "<Name>"
+ */
+static int perl_config_basename (oconfig_item_t *ci)
+{
+ char *value = NULL;
+
+ if ((0 != ci->children_num) || (1 != ci->values_num)
+ || (OCONFIG_TYPE_STRING != ci->values[0].type))
+ return 1;
+
+ value = ci->values[0].value.string;
+
+ log_debug ("perl_config: Setting plugin basename to \"%s\"", value);
+ strncpy (base_name, value, sizeof (base_name));
+ base_name[sizeof (base_name) - 1] = '\0';
+ return 0;
+} /* static int perl_config_basename (oconfig_item_it *) */
+
+/*
+ * EnableDebugger "<Package>"|""
+ */
+static int perl_config_enabledebugger (oconfig_item_t *ci)
+{
+ char *value = NULL;
+
+ if ((0 != ci->children_num) || (1 != ci->values_num)
+ || (OCONFIG_TYPE_STRING != ci->values[0].type))
+ return 1;
+
+ value = ci->values[0].value.string;
+
+ perl_argv = (char **)realloc (perl_argv,
+ (++perl_argc + 1) * sizeof (char *));
+
+ if (NULL == perl_argv) {
+ log_err ("perl_config: Not enough memory.");
+ exit (3);
}
- else if (0 == strcasecmp (key, "IncludeDir")) {
+
+ if ('\0' == value[0]) {
+ perl_argv[perl_argc - 1] = "-d";
+ }
+ else {
+ perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 4);
+ sstrncpy (perl_argv[perl_argc - 1], "-d:", 4);
+ sstrncpy (perl_argv[perl_argc - 1] + 3, value, strlen (value) + 1);
+ }
+
+ perl_argv[perl_argc] = NULL;
+ return 0;
+} /* static int perl_config_enabledebugger (oconfig_item_it *) */
+
+/*
+ * IncludeDir "<Dir>"
+ */
+static int perl_config_includedir (oconfig_item_t *ci)
+{
+ char *value = NULL;
+
+ if ((0 != ci->children_num) || (1 != ci->values_num)
+ || (OCONFIG_TYPE_STRING != ci->values[0].type))
+ return 1;
+
+ value = ci->values[0].value.string;
+
+ if (NULL == perl) {
perl_argv = (char **)realloc (perl_argv,
(++perl_argc + 1) * sizeof (char *));
perl_argv[perl_argc] = NULL;
}
else {
- return -1;
+ /* prepend the directory to @INC */
+ Perl_av_unshift (perl, GvAVn (PL_incgv), 1);
+ Perl_av_store (perl, GvAVn (PL_incgv),
+ 0, Perl_newSVpv (perl, value, strlen (value)));
+ }
+ return 0;
+} /* static int perl_config_includedir (oconfig_item_it *) */
+
+static int perl_config (oconfig_item_t *ci)
+{
+ int i = 0;
+
+ for (i = 0; i < ci->children_num; ++i) {
+ oconfig_item_t *c = ci->children + i;
+
+ if (0 == strcasecmp (c->key, "LoadPlugin"))
+ perl_config_loadplugin (c);
+ else if (0 == strcasecmp (c->key, "BaseName"))
+ perl_config_basename (c);
+ else if (0 == strcasecmp (c->key, "EnableDebugger"))
+ perl_config_enabledebugger (c);
+ else if (0 == strcasecmp (c->key, "IncludeDir"))
+ perl_config_includedir (c);
+ else
+ log_warn ("Ignoring unknown config key \"%s\".", c->key);
}
return 0;
-} /* static int perl_config (char *, char *) */
+} /* static int perl_config (oconfig_item_t *) */
void module_register (void)
{
perl_argv[3] = "1";
perl_argv[4] = NULL;
- plugin_register_config ("perl", perl_config, config_keys, config_keys_num);
+ plugin_register_complex_config ("perl", perl_config);
return;
} /* void module_register (void) */
projects / collectd.git / blobdiff