* Init perl and do all perl specific operations from the single place in code

* Push objects correctly to stack (by blessing them and making hash reference)

3 files changed, 111 insertions, 62 deletions

diff --git a/src/main.c b/src/main.c
index e33d6e8dd..ee41b66dd 100644
--- a/src/main.c
+++ b/src/main.c
@@ -16,17 +16,13 @@
 #endif
 #include <syslog.h>
 
-#include <EXTERN.h>               /* from the Perl distribution     */
-#include <perl.h>                 /* from the Perl distribution     */
-
 #include "main.h"
 #include "cfg_file.h"
 #include "util.h"
+#include "perl.h"
 
 /* 2 seconds to fork new process in place of dead one */
 #define SOFT_FORK_TIME 2
-/* Perl module init function */
-#define MODULE_INIT_FUNC "module_init"
 
 struct config_file *cfg;
 
@@ -41,12 +37,10 @@ sig_atomic_t got_alarm;
 
 extern int yynerrs;
 extern FILE *yyin;
-extern void boot_DynaLoader (pTHX_ CV* cv);
-extern void boot_Socket (pTHX_ CV* cv);
+extern void xs_init(pTHX);
+
 
-PerlInterpreter *perl_interpreter;
-/* XXX: remove this shit when it would be clear why perl need this line */
-PerlInterpreter *my_perl;
+extern PerlInterpreter *perl_interpreter;
 
 /* List of workers that are pending to start */
 static GList *workers_pending = NULL;
@@ -75,43 +69,6 @@ void sig_handler (int signo)
 	}
 }
 
-void
-xs_init(pTHX)
-{
-	dXSUB_SYS;
-	/* DynaLoader is a special case */
-	newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
-}
-
-static void
-init_filters (struct config_file *cfg)
-{
-	struct perl_module *module;
-    char *init_func, *class;
-    size_t funclen;
-    dSP;
-
-	LIST_FOREACH (module, &cfg->perl_modules, next) {
-		if (module->path) {
-			require_pv (module->path);
-            ENTER;
-	        SAVETMPS;
-
-	        PUSHMARK (SP);
-            XPUSHs (sv_2mortal (newSVpv (class, 0)));
-	        XPUSHs (sv_2mortal (newSViv (PTR2IV (cfg))));
-	        PUTBACK;
-	        /* Call module init function */
-            funclen = strlen (module->path) + sizeof ("::") + sizeof (MODULE_INIT_FUNC) - 1;
-            init_func = g_malloc (funclen);
-            snptintf (init_func, funclen, "%s::%s", module->path, MODULE_INIT_FUNC);
-            call_method (init_func, G_DISCARD);
-
-            FREETMPS;
-            LEAVE;
-		}
-	}
-}
 
 static struct rspamd_worker *
 fork_worker (struct rspamd_main *rspamd, int listen_sock, int reconfig, enum process_type type) 
@@ -333,6 +290,7 @@ main (int argc, char **argv, char **env)
 	
 	init_signals (&signals, sig_handler);
 	/* Init perl interpreter */
+	dTHXa (perl_interpreter);
 	PERL_SYS_INIT3 (&argc, &argv, &env);
 	perl_interpreter = perl_alloc ();
 	if (perl_interpreter == NULL) {
@@ -340,7 +298,6 @@ main (int argc, char **argv, char **env)
 		exit (-errno);
 	}
 
-	my_perl = perl_interpreter;
 	PERL_SET_CONTEXT (perl_interpreter);
 	perl_construct (perl_interpreter);
 	PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
diff --git a/src/perl.c b/src/perl.c
index 870283835..607516439 100644
--- a/src/perl.c
+++ b/src/perl.c
@@ -7,26 +7,82 @@
 
 #include <glib.h>
 
-#include <EXTERN.h>               /* from the Perl distribution     */
-#include <perl.h>                 /* from the Perl distribution     */
-
 #include "url.h"
 #include "main.h"
 #include "perl.h"
+#include "cfg_file.h"
+
+/* Perl module init function */
+#define MODULE_INIT_FUNC "module_init"
+
+PerlInterpreter *perl_interpreter;
+
+static HV  *rspamd_stash;
+
+extern void boot_DynaLoader (pTHX_ CV* cv);
+extern void boot_Socket (pTHX_ CV* cv);
+
+void
+xs_init(pTHX)
+{
+	dXSUB_SYS;
+	/* DynaLoader is a special case */
+	newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
+
+    rspamd_stash = gv_stashpv("rspamd", TRUE);
+}
+
+void
+init_perl_filters (struct config_file *cfg)
+{
+	struct perl_module *module;
+    char *init_func;
+    size_t funclen;
+	SV* sv;
+    
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
+
+    dSP;
+	LIST_FOREACH (module, &cfg->perl_modules, next) {
+		if (module->path) {
+			require_pv (module->path);
+            ENTER;
+	        SAVETMPS;
+
+	        PUSHMARK (SP);
+			sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(cfg))), rspamd_stash));
+	        XPUSHs (sv);
+	        PUTBACK;
+	        /* Call module init function */
+            funclen = strlen (module->path) + sizeof ("::") + sizeof (MODULE_INIT_FUNC) - 1;
+            init_func = g_malloc (funclen);
+            snprintf (init_func, funclen, "%s::%s", module->path, MODULE_INIT_FUNC);
+            call_pv (init_func, G_DISCARD);
+
+            FREETMPS;
+            LEAVE;
+		}
+	}
+}
 
-extern PerlInterpreter *my_perl;
 
 int
 perl_call_header_filter (const char *function, struct worker_task *task)
 {
 	int result;
-	dSP;
+	SV* sv;
 
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
+
+	dSP;
 	ENTER;
 	SAVETMPS;
 
 	PUSHMARK (SP);
-	XPUSHs (sv_2mortal (newSViv (PTR2IV (task))));
+	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash));
+	XPUSHs (sv);
 	PUTBACK;
 	
 	call_pv (function, G_SCALAR);
@@ -47,13 +103,18 @@ int
 perl_call_mime_filter (const char *function, struct worker_task *task)
 {
 	int result;
-	dSP;
+	SV *sv;
+
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
 
+	dSP;
 	ENTER;
 	SAVETMPS;
 
 	PUSHMARK (SP);
-	XPUSHs (sv_2mortal (newSViv (PTR2IV (task))));
+	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash));
+	XPUSHs (sv);
 	PUTBACK;
 	
 	call_pv (function, G_SCALAR);
@@ -74,13 +135,18 @@ int
 perl_call_message_filter (const char *function, struct worker_task *task)
 {
 	int result;
-	dSP;
+	SV *sv;
+
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
 
+	dSP;
 	ENTER;
 	SAVETMPS;
 
 	PUSHMARK (SP);
-	XPUSHs (sv_2mortal (newSViv (PTR2IV (task))));
+	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash));
+	XPUSHs (sv);
 	PUTBACK;
 	
 	call_pv (function, G_SCALAR);
@@ -101,13 +167,18 @@ int
 perl_call_url_filter (const char *function, struct worker_task *task)
 {
 	int result;
-	dSP;
+	SV *sv;
+
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
 
+	dSP;
 	ENTER;
 	SAVETMPS;
 	
 	PUSHMARK (SP);
-	XPUSHs (sv_2mortal (newSViv (PTR2IV (task))));
+	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash));
+	XPUSHs (sv);
 	PUTBACK;
 	
 	call_pv (function, G_SCALAR);
@@ -129,6 +200,10 @@ perl_call_chain_filter (const char *function, struct worker_task *task, int *mar
 {
 	int result, i;
 	AV *av;
+	SV *sv;
+
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
 
 	dSP;
 	
@@ -140,7 +215,8 @@ perl_call_chain_filter (const char *function, struct worker_task *task, int *mar
 		av_push (av, sv_2mortal (newSViv (marks[i])));
 	}
 	PUSHMARK (SP);
-	XPUSHs (sv_2mortal (newSViv (PTR2IV (task))));
+	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(task))), rspamd_stash));
+	XPUSHs (sv);
 	XPUSHs (sv_2mortal ((SV *)AvARRAY (av)));
 	PUTBACK;
 	
@@ -166,13 +242,18 @@ void perl_call_memcached_callback (memcached_ctx_t *ctx, memc_error_t error, voi
         SV *callback;
         struct worker_task *task;
     } *callback_data = data;
+	SV *sv;
 	
+	dTHXa (perl_interpreter);
+	PERL_SET_CONTEXT (perl_interpreter);
+
 	dSP;
 
 	ENTER;
 	SAVETMPS;
 	PUSHMARK (SP);
-	XPUSHs (sv_2mortal (newSViv (PTR2IV (callback_data->task))));
+	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV(callback_data->task))), rspamd_stash));
+	XPUSHs (sv);
 	XPUSHs (sv_2mortal (newSViv (error)));
 	XPUSHs (sv_2mortal (newSVpv (ctx->param->buf, ctx->param->bufsize)));
 	PUTBACK;
diff --git a/src/perl.h b/src/perl.h
index 9a37634e3..7aabe1895 100644
--- a/src/perl.h
+++ b/src/perl.h
@@ -5,8 +5,19 @@
 #include <glib.h>
 #include "memcached.h"
 
+#include <EXTERN.h>               /* from the Perl distribution     */
+#include <perl.h>                 /* from the Perl distribution     */
+
+#ifndef PERL_IMPLICIT_CONTEXT
+#undef  dTHXa
+#define dTHXa(a)
+#endif
+
 struct uri;
 struct worker_task;
+struct config_file;
+
+void init_perl_filters (struct config_file *cfg);
 
 int perl_call_header_filter (const char *function, struct worker_task *task);
 int perl_call_mime_filter (const char *function, struct worker_task *task);