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

diff --git a/src/perl.c b/src/perl.c
index 8c21e45c..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,17 +65,6 @@ 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
  */
@@ -88,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));
@@ -123,7 +109,6 @@ struct {
 	{ "", 0 }
 };
 
-
 /*
  * Helper functions for data type conversion.
  */
@@ -182,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;
 
@@ -197,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);
@@ -327,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.
  */
@@ -355,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;
 
@@ -368,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);
 
@@ -386,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';
 
@@ -409,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 *) */
 
@@ -461,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);
@@ -606,7 +567,6 @@ static int pplugin_call_all (int type, ...)
 	return ret;
 } /* static int pplugin_call_all (int, ...) */
 
-
 /*
  * Exported Perl API.
  */
@@ -743,7 +703,6 @@ static XS (Collectd_plugin_log)
 	XSRETURN_YES;
 } /* static XS (Collectd_plugin_log) */
 
-
 /*
  * Interface to collectd.
  */
@@ -802,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 */
@@ -883,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,8 +857,8 @@ static int perl_config_loadplugin (oconfig_item_t *ci)
 	char *value = NULL;
 
 	if ((0 != ci->children_num) || (1 != ci->values_num)
-			|| (OCONFIG_TYPE_STRING != ci->values[0].type)) {
-	}
+			|| (OCONFIG_TYPE_STRING != ci->values[0].type))
+		return 1;
 
 	value = ci->values[0].value.string;
 
@@ -934,8 +884,8 @@ 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)) {
-	}
+			|| (OCONFIG_TYPE_STRING != ci->values[0].type))
+		return 1;
 
 	value = ci->values[0].value.string;
 
@@ -953,8 +903,8 @@ 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)) {
-	}
+			|| (OCONFIG_TYPE_STRING != ci->values[0].type))
+		return 1;
 
 	value = ci->values[0].value.string;
 
@@ -987,24 +937,32 @@ 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)) {
-	}
+			|| (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) {
+		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 (NULL == perl_argv) {
+			log_err ("perl_config: Not enough memory.");
+			exit (3);
+		}
 
-	perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 3);
-	sstrncpy(perl_argv[perl_argc - 1], "-I", 3);
-	sstrncpy(perl_argv[perl_argc - 1] + 2, value, strlen (value) + 1);
+		perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 3);
+		sstrncpy(perl_argv[perl_argc - 1], "-I", 3);
+		sstrncpy(perl_argv[perl_argc - 1] + 2, value, strlen (value) + 1);
 
-	perl_argv[perl_argc] = NULL;
+		perl_argv[perl_argc] = NULL;
+	}
+	else {
+		/* 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 *) */