Merge branch 'collectd-4.2'

[collectd.git] / src / perl.c

diff --git a/src/perl.c b/src/perl.c
index b289fa0..dc548b2 100644 (file)
--- a/src/perl.c
+++ b/src/perl.c
@@ -154,6 +154,24 @@ struct {
        { "", 0 }
 };
 
+struct {
+       char  name[64];
+       char *var;
+} g_strings[] =
+{
+       { "Collectd::hostname_g", hostname_g },
+       { "", NULL }
+};
+
+struct {
+       char  name[64];
+       int  *var;
+} g_integers[] =
+{
+       { "Collectd::interval_g", &interval_g },
+       { "", NULL }
+};
+
 /*
  * Helper functions for data type conversion.
  */
@@ -370,6 +388,7 @@ static char *get_module_name (char *buf, size_t buf_len, const char *module) {
 static int pplugin_register_data_set (pTHX_ char *name, AV *dataset)
 {
        int len = -1;
+       int ret = 0;
        int i   = 0;
 
        data_source_t *ds  = NULL;
@@ -410,7 +429,12 @@ static int pplugin_register_data_set (pTHX_ char *name, AV *dataset)
 
        set->ds_num = len + 1;
        set->ds = ds;
-       return plugin_register_data_set (set);
+
+       ret = plugin_register_data_set (set);
+
+       free (ds);
+       free (set);
+       return ret;
 } /* static int pplugin_register_data_set (char *, SV *) */
 
 /*
@@ -1029,10 +1053,50 @@ static int perl_shutdown (void)
        return ret;
 } /* static void perl_shutdown (void) */
 
+/*
+ * Access functions for global variables.
+ *
+ * These functions implement the "magic" used to access
+ * the global variables from Perl.
+ */
+
+static int g_pv_get (pTHX_ SV *var, MAGIC *mg)
+{
+       char *pv = mg->mg_ptr;
+       sv_setpv (var, pv);
+       return 0;
+} /* static int g_pv_get (pTHX_ SV *, MAGIC *) */
+
+static int g_pv_set (pTHX_ SV *var, MAGIC *mg)
+{
+       char *pv = mg->mg_ptr;
+       strncpy (pv, SvPV_nolen (var), DATA_MAX_NAME_LEN);
+       pv[DATA_MAX_NAME_LEN - 1] = '\0';
+       return 0;
+} /* static int g_pv_set (pTHX_ SV *, MAGIC *) */
+
+static int g_iv_get (pTHX_ SV *var, MAGIC *mg)
+{
+       int *iv = (int *)mg->mg_ptr;
+       sv_setiv (var, *iv);
+       return 0;
+} /* static int g_iv_get (pTHX_ SV *, MAGIC *) */
+
+static int g_iv_set (pTHX_ SV *var, MAGIC *mg)
+{
+       int *iv = (int *)mg->mg_ptr;
+       *iv = (int)SvIV (var);
+       return 0;
+} /* static int g_iv_set (pTHX_ SV *, MAGIC *) */
+
+static MGVTBL g_pv_vtbl = { g_pv_get, g_pv_set, NULL, NULL, NULL };
+static MGVTBL g_iv_vtbl = { g_iv_get, g_iv_set, NULL, NULL, NULL };
+
 /* bootstrap the Collectd module */
 static void xs_init (pTHX)
 {
        HV   *stash = NULL;
+       SV   *tmp   = NULL;
        char *file  = __FILE__;
 
        int i = 0;
@@ -1051,6 +1115,25 @@ static void xs_init (pTHX)
        /* export "constants" */
        for (i = 0; '\0' != constants[i].name[0]; ++i)
                newCONSTSUB (stash, constants[i].name, newSViv (constants[i].value));
+
+       /* export global variables
+        * by adding "magic" to the SV's representing the globale variables
+        * perl is able to automagically call the get/set function when
+        * accessing any such variable (this is basically the same as using
+        * tie() in Perl) */
+       /* global strings */
+       for (i = 0; '\0' != g_strings[i].name[0]; ++i) {
+               tmp = get_sv (g_strings[i].name, 1);
+               sv_magicext (tmp, NULL, PERL_MAGIC_ext, &g_pv_vtbl,
+                               g_strings[i].var, 0);
+       }
+
+       /* global integers */
+       for (i = 0; '\0' != g_integers[i].name[0]; ++i) {
+               tmp = get_sv (g_integers[i].name, 1);
+               sv_magicext (tmp, NULL, PERL_MAGIC_ext, &g_iv_vtbl,
+                               (char *)g_integers[i].var, 0);
+       }
        return;
 } /* static void xs_init (pTHX) */
 
@@ -1093,7 +1176,7 @@ static int init_pi (int argc, char **argv)
        perl_threads->tail = perl_threads->head;
 
        if (NULL == (perl_threads->head->interp = perl_alloc ())) {
-               log_err ("module_register: Not enough memory.");
+               log_err ("init_pi: Not enough memory.");
                exit (3);
        }
 
@@ -1105,7 +1188,7 @@ static int init_pi (int argc, char **argv)
        PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 
        if (0 != perl_parse (aTHX_ xs_init, argc, argv, NULL)) {
-               log_err ("module_register: Unable to bootstrap Collectd.");
+               log_err ("init_pi: Unable to bootstrap Collectd.");
                exit (1);
        }
 
@@ -1134,8 +1217,10 @@ static int perl_config_loadplugin (pTHX_ 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)) {
+               log_err ("LoadPlugin expects a single string argument.");
                return 1;
+       }
 
        value = ci->values[0].value.string;
 
@@ -1164,8 +1249,10 @@ static int perl_config_basename (pTHX_ 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)) {
+               log_err ("BaseName expects a single string argument.");
                return 1;
+       }
 
        value = ci->values[0].value.string;
 
@@ -1183,8 +1270,10 @@ static int perl_config_enabledebugger (pTHX_ 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)) {
+               log_err ("EnableDebugger expects a single string argument.");
                return 1;
+       }
 
        value = ci->values[0].value.string;
 
@@ -1217,8 +1306,10 @@ static int perl_config_includedir (pTHX_ 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)) {
+               log_err ("IncludeDir expects a single string argument.");
                return 1;
+       }
 
        value = ci->values[0].value.string;