[collectd] [PATCH] perl plugin: Made global variables available to Perl plugins.

[Sebastian Harl]

The "let's become magical" commit.

Each global variable (currently hostname_g and interval_g) will be exported by
introducing an equally named Perl variable. Perl's concept of "magic" is used
to create a read/write interface to the C variables (think of the variables as
being tied). This way any changes to the C variables will be immediately
accessible from the Perl plugin and vice versa.

Signed-off-by: Sebastian Harl <sh at tokkee.org>
---
 bindings/perl/Collectd.pm |    4 ++
 src/collectd-perl.pod     |   29 +++++++++++++++++
 src/perl.c                |   77 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 110 insertions(+), 0 deletions(-)

diff --git a/bindings/perl/Collectd.pm b/bindings/perl/Collectd.pm
index 2de9885..95a8a0a 100644
--- a/bindings/perl/Collectd.pm
+++ b/bindings/perl/Collectd.pm
@@ -68,6 +68,10 @@ our %EXPORT_TAGS = (
 			LOG_INFO
 			LOG_DEBUG
 	) ],
+	'globals' => [ qw(
+			$hostname_g
+			$interval_g
+	) ],
 );
 
 {
diff --git a/src/collectd-perl.pod b/src/collectd-perl.pod
index 842d0bb..ffe5177 100644
--- a/src/collectd-perl.pod
+++ b/src/collectd-perl.pod
@@ -260,6 +260,25 @@ B<LOG_NOTICE>, B<LOG_INFO> and B<LOG_DEBUG> respectively as I<log-level>.
 
 =back
 
+=head1 GLOBAL VARIABLES
+
+=over 4
+
+=item B<$hostname_g>
+
+As the name suggests this variable keeps the hostname of the system collectd
+is running on. The value might be influenced by the B<Hostname> or
+B<FQDNLookup> configuration options (see L<collectd.conf(5)> for details).
+
+=item B<$interval_g>
+
+This variable keeps the interval in seconds in which the read functions are
+queried (see the B<Interval> configuration option).
+
+=back
+
+Any changes to these variables will be globally visible in collectd.
+
 =head1 EXPORTS
 
 By default no symbols are exported. However, the following export tags are
@@ -333,6 +352,16 @@ available (B<:all> will export all of them):
 
 =back
 
+=item B<:globals>
+
+=over 4
+
+=item B<$hostname_g>
+
+=item B<$interval_g>
+
+=back
+
 =back
 
 =head1 EXAMPLES
diff --git a/src/perl.c b/src/perl.c
index 0d9474a..c0e99f5 100644
--- 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.
  */
@@ -1029,10 +1047,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 +1109,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) */
 
-- 
1.5.3.6.736.gb7f30

-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://mailman.verplant.org/pipermail/collectd/attachments/20071122/36d8d0fd/attachment.pgp