X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;f=src%2Fperl.c;h=1ed9d003d12ad84d3ce105fd18bdca70f8c6931d;hb=bc6790409971d84b1c8aa7201667c869e155e03b;hp=3b91e5f4abc97fdb6b2fe0ce4a443737014857b2;hpb=eca5237ba1652a2517cabf47a355efb193cec5f9;p=collectd.git

diff --git a/src/perl.c b/src/perl.c
index 3b91e5f4..1ed9d003 100644
--- a/src/perl.c
+++ b/src/perl.c
@@ -57,7 +57,6 @@
 #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 *);
 
@@ -66,31 +65,10 @@ 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;
-
-
 /*
  * private variables
  */
 
-/* valid configuration file keys */
-static const char *config_keys[] =
-{
-	"LoadPlugin",
-	"BaseName",
-	"EnableDebugger",
-	"IncludeDir"
-};
-static int config_keys_num = STATIC_ARRAY_SIZE (config_keys);
-
 static PerlInterpreter *perl = NULL;
 
 static int  perl_argc   = 0;
@@ -98,8 +76,6 @@ static char **perl_argv = NULL;
 
 static char base_name[DATA_MAX_NAME_LEN] = "";
 
-static HV   *data_sets;
-
 static struct {
 	char name[64];
 	XS ((*f));
@@ -133,7 +109,6 @@ struct {
 	{ "", 0 }
 };
 
-
 /*
  * Helper functions for data type conversion.
  */
@@ -192,9 +167,7 @@ static int hv2data_source (HV *hash, data_source_t *ds)
 
 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;
 
@@ -207,23 +180,22 @@ static int av2value (char *name, AV *array, value_t *value, int len)
 	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);
@@ -337,7 +309,6 @@ static int value_list2hv (value_list_t *vl, data_set_t *ds, HV *hash)
 	return 0;
 } /* static int value2av (value_list_t *, data_set_t *, HV *) */
 
-
 /*
  * Internal functions.
  */
@@ -365,8 +336,6 @@ 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;
 
@@ -378,10 +347,6 @@ static int pplugin_register_data_set (char *name, AV *dataset)
 	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);
 
@@ -396,16 +361,11 @@ static int pplugin_register_data_set (char *name, AV *dataset)
 		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';
 
@@ -419,20 +379,8 @@ static int pplugin_register_data_set (char *name, AV *dataset)
  */
 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 *) */
 
@@ -471,6 +419,9 @@ static int pplugin_dispatch_values (char *name, HV *values)
 		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);
@@ -616,7 +567,6 @@ static int pplugin_call_all (int type, ...)
 	return ret;
 } /* static int pplugin_call_all (int, ...) */
 
-
 /*
  * Exported Perl API.
  */
@@ -753,7 +703,6 @@ static XS (Collectd_plugin_log)
 	XSRETURN_YES;
 } /* static XS (Collectd_plugin_log) */
 
-
 /*
  * Interface to collectd.
  */
@@ -799,7 +748,7 @@ static int perl_shutdown (void)
 {
 	int ret = 0;
 
-	plugin_unregister_config ("perl");
+	plugin_unregister_complex_config ("perl");
 
 	if (NULL == perl)
 		return 0;
@@ -812,17 +761,6 @@ static int perl_shutdown (void)
 	PERL_SET_CONTEXT (perl);
 	ret = pplugin_call_all (PLUGIN_SHUTDOWN);
 
-	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 */
@@ -893,9 +831,11 @@ static int init_pi (int argc, char **argv)
 		log_err ("module_register: Unable to bootstrap Collectd.");
 		exit (1);
 	}
-	perl_run (perl);
 
-	data_sets = 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");
+
+	perl_run (perl);
 
 	plugin_register_log ("perl", perl_log);
 	plugin_register_init ("perl", perl_init);
@@ -907,52 +847,102 @@ static int init_pi (int argc, char **argv)
 	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_debug ("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';
-	}
-	else if (0 == strcasecmp (key, "EnableDebugger")) {
-		perl_argv = (char **)realloc (perl_argv,
-				(++perl_argc + 1) * sizeof (char *));
 
-		if (NULL == perl_argv) {
-			log_err ("perl_config: Not enough memory.");
-			exit (3);
-		}
+	init_pi (perl_argc, perl_argv);
 
-		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);
-		}
+	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 *) */
 
-		perl_argv[perl_argc] = NULL;
+/*
+ * 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);
+	}
+
+	if ('\0' == value[0]) {
+		perl_argv[perl_argc - 1] = "-d";
 	}
-	else if (0 == strcasecmp (key, "IncludeDir")) {
+	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 *));
 
@@ -968,10 +958,34 @@ static int perl_config (const char *key, const char *value)
 		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)
 {
@@ -985,7 +999,7 @@ 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) */