+ * Collectd::call_by_name (...).
+ *
+ * Call a Perl sub identified by its name passed through $Collectd::cb_name.
+ */
+static XS (Collectd_call_by_name)
+{
+ SV *tmp = NULL;
+ char *name = NULL;
+
+ if (NULL == (tmp = get_sv ("Collectd::cb_name", 0))) {
+ sv_setpv (get_sv ("@", 1), "cb_name has not been set");
+ CLEAR_STACK_FRAME;
+ return;
+ }
+
+ name = SvPV_nolen (tmp);
+
+ if (NULL == get_cv (name, 0)) {
+ sv_setpvf (get_sv ("@", 1), "unknown callback \"%s\"", name);
+ CLEAR_STACK_FRAME;
+ return;
+ }
+
+ /* simply pass on the subroutine call without touching the stack,
+ * thus leaving any arguments and return values in place */
+ call_pv (name, 0);
+} /* static XS (Collectd_call_by_name) */
+
+/*
+ * collectd's perl interpreter based thread implementation.
+ *
+ * This has been inspired by Perl's ithreads introduced in version 5.6.0.
+ */
+
+/* must be called with perl_threads->mutex locked */
+static void c_ithread_destroy (c_ithread_t *ithread)
+{
+ dTHXa (ithread->interp);
+
+ assert (NULL != perl_threads);
+
+ PERL_SET_CONTEXT (aTHX);
+ log_debug ("Shutting down Perl interpreter %p...", aTHX);
+
+#if COLLECT_DEBUG
+ sv_report_used ();
+
+ --perl_threads->number_of_threads;
+#endif /* COLLECT_DEBUG */
+
+ perl_destruct (aTHX);
+ perl_free (aTHX);
+
+ if (NULL == ithread->prev)
+ perl_threads->head = ithread->next;
+ else
+ ithread->prev->next = ithread->next;
+
+ if (NULL == ithread->next)
+ perl_threads->tail = ithread->prev;
+ else
+ ithread->next->prev = ithread->prev;
+
+ sfree (ithread);
+ return;
+} /* static void c_ithread_destroy (c_ithread_t *) */
+
+static void c_ithread_destructor (void *arg)
+{
+ c_ithread_t *ithread = (c_ithread_t *)arg;
+ c_ithread_t *t = NULL;
+
+ if (NULL == perl_threads)
+ return;
+
+ pthread_mutex_lock (&perl_threads->mutex);
+
+ for (t = perl_threads->head; NULL != t; t = t->next)
+ if (t == ithread)
+ break;
+
+ /* the ithread no longer exists */
+ if (NULL == t)
+ return;
+
+ c_ithread_destroy (ithread);
+
+ pthread_mutex_unlock (&perl_threads->mutex);
+ return;
+} /* static void c_ithread_destructor (void *) */
+
+/* must be called with perl_threads->mutex locked */
+static c_ithread_t *c_ithread_create (PerlInterpreter *base)
+{
+ c_ithread_t *t = NULL;
+ dTHXa (NULL);
+
+ assert (NULL != perl_threads);
+
+ t = (c_ithread_t *)smalloc (sizeof (c_ithread_t));
+ memset (t, 0, sizeof (c_ithread_t));
+
+ t->interp = (NULL == base)
+ ? NULL
+ : perl_clone (base, CLONEf_KEEP_PTR_TABLE);
+
+ aTHX = t->interp;
+
+ if ((NULL != base) && (NULL != PL_endav)) {
+ av_clear (PL_endav);
+ av_undef (PL_endav);
+ PL_endav = Nullav;
+ }
+
+#if COLLECT_DEBUG
+ ++perl_threads->number_of_threads;
+#endif /* COLLECT_DEBUG */
+
+ t->next = NULL;
+
+ if (NULL == perl_threads->tail) {
+ perl_threads->head = t;
+ t->prev = NULL;
+ }
+ else {
+ perl_threads->tail->next = t;
+ t->prev = perl_threads->tail;
+ }
+
+ perl_threads->tail = t;
+
+ pthread_setspecific (perl_thr_key, (const void *)t);
+ return t;
+} /* static c_ithread_t *c_ithread_create (PerlInterpreter *) */
+
+/*