* 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)

diff --git a/src/main.c b/src/main.c
index e33d6e8ddd4df52c9152f626c19dd1f630accb34..ee41b66dd7bf93d6a9ac0509f3c39e41e95fb181 100644 (file)
--- 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 8702838351a8c2e72e8af389b484445103f442a5..6075164399c8d252ad822ad39ded78aed23e52ec 100644 (file)
--- 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 9a37634e3743ed8908b404ccc8ad0c040869d6cd..7aabe1895ac34aff5017eb50ca8590b69c5e97d6 100644 (file)
--- 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);