/*
 * 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;
	msg_debug ("header_filter: 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;
	msg_debug ("chain_filter: 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;
}