/*
 * Copyright (c) 2009, Rambler media
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *	 * Redistributions of source code must retain the above copyright
 *	   notice, this list of conditions and the following disclaimer.
 *	 * Redistributions in binary form must reproduce the above copyright
 *	   notice, this list of conditions and the following disclaimer in the
 *	   documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY Rambler media ''AS IS'' AND ANY
 * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED. IN NO EVENT SHALL Rambler BE LIABLE FOR ANY
 * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
 * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

#include "config.h"
#include "url.h"
#include "main.h"
#include "perl.h"
#include "cfg_file.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

/* Perl module init function */
#define MODULE_INIT_FUNC "module_init"

PerlInterpreter                *perl_interpreter;

static HV                      *rspamd_task_stash;
static HV                      *rspamd_cfg_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_task_stash = gv_stashpv ("rspamd_task", TRUE);
	rspamd_cfg_stash = gv_stashpv ("rspamd_config", 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_cfg_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;
		}
	}
}


int
perl_call_header_filter (const char *function, struct worker_task *task)
{
	int                             result;
	SV                             *sv;

	dTHXa (perl_interpreter);
	PERL_SET_CONTEXT (perl_interpreter);

	dSP;
	ENTER;
	SAVETMPS;

	PUSHMARK (SP);
	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV (task))), rspamd_task_stash));
	XPUSHs (sv);
	PUTBACK;

	call_pv (function, G_SCALAR);

	SPAGAIN;

	result = POPi;
	debug_task ("call of %s with returned mark %d\n", function, result);

	PUTBACK;
	FREETMPS;
	LEAVE;

	return result;
}

int
perl_call_chain_filter (const char *function, struct worker_task *task, int *marks, unsigned int number)
{
	int                             result, i;
	AV                             *av;
	SV                             *sv;

	dTHXa (perl_interpreter);
	PERL_SET_CONTEXT (perl_interpreter);

	dSP;

	ENTER;
	SAVETMPS;
	av = newAV ();
	av_extend (av, number);
	for (i = 0; i < number; i++) {
		av_push (av, sv_2mortal (newSViv (marks[i])));
	}
	PUSHMARK (SP);
	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV (task))), rspamd_task_stash));
	XPUSHs (sv);
	XPUSHs (sv_2mortal ((SV *) AvARRAY (av)));
	PUTBACK;

	call_pv (function, G_SCALAR);

	SPAGAIN;

	result = POPi;
	debug_task ("call of %s returned mark %d\n", function, result);

	PUTBACK;
	FREETMPS;
	av_undef (av);
	LEAVE;


	return result;
}

void
perl_call_memcached_callback (memcached_ctx_t * ctx, memc_error_t error, void *data)
{
	struct {
		SV                             *callback;
		struct worker_task             *task;
	}                              *callback_data = data;
	SV                             *sv;

	dTHXa (perl_interpreter);
	PERL_SET_CONTEXT (perl_interpreter);

	dSP;

	ENTER;
	SAVETMPS;
	PUSHMARK (SP);
	sv = sv_2mortal (sv_bless (newRV_noinc (newSViv (PTR2IV (callback_data->task))), rspamd_task_stash));
	XPUSHs (sv);
	XPUSHs (sv_2mortal (newSViv (error)));
	XPUSHs (sv_2mortal (newSVpv (ctx->param->buf, ctx->param->bufsize)));
	PUTBACK;

	call_sv (callback_data->callback, G_SCALAR);

	/* Set save point */
	callback_data->task->save.saved = 0;
	process_filters (callback_data->task);

	SPAGAIN;
	FREETMPS;
	LEAVE;

}

/*
 * Perl custom consolidation function
 */
struct consolidation_callback_data {
	struct worker_task             *task;
	double                          score;
	const char                     *func;
};

static void
perl_consolidation_callback (gpointer key, gpointer value, gpointer arg)
{
	double                          res;
	struct symbol                  *s = (struct symbol *)value;
	struct consolidation_callback_data *data = (struct consolidation_callback_data *)arg;

	dTHXa (perl_interpreter);
	PERL_SET_CONTEXT (perl_interpreter);

	dSP;
	ENTER;
	SAVETMPS;

	PUSHMARK (SP);

	XPUSHs (sv_2mortal (newSVpv ((const char *)key, 0)));
	XPUSHs (sv_2mortal (newSVnv (s->score)));
	PUTBACK;

	call_pv (data->func, G_SCALAR);

	SPAGAIN;

	res = POPi;

	data->score += res;
}

double
perl_consolidation_func (struct worker_task *task, const char *metric_name, const char *function_name)
{
	struct metric_result           *metric_res;
	double                          res = 0.;
	struct consolidation_callback_data data = { task, 0, function_name };

	if (function_name == NULL) {
		return 0;
	}

	metric_res = g_hash_table_lookup (task->results, metric_name);
	if (metric_res == NULL) {
		return res;
	}

	g_hash_table_foreach (metric_res->symbols, perl_consolidation_callback, &data);

	return data.score;
}