/* ARISA - Perl Engine - Message Handling Linkage
 *
 * Elements taken or derived from irssi (http://irssi.org).
 * Those elements,	Copyright (C) 2000 Timo Sirainen
 * All other elements,	Copyright (C) 2004 Carl Ritson
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 */

#define NEED_PERL_H

#include <EXTERN.h>
#include <perl.h>

#include <XSUB.h>

#include "arisa.h"
#include "script-eng.h"
#include "engine.h"
#include "linkage.h"
#include "ui.h"

#include <zlib.h>

#include "arisa-core.pl.h"
#include "perl-modules.h"

extern void boot_DynaLoader(pTHX_ CV* cv);
extern void boot_Arisa(CV *cv);

XS(boot_Arisa_Core) {
	dXSARGS;

	arisa_callXS(boot_Arisa, cv, mark);

	XSRETURN_YES;
}

static void xs_init(pTHX) {
	dXSUB_SYS;

	newXS("Arisa::Core::boot_Arisa_Core", boot_Arisa_Core, __FILE__);
	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
}

/** arisa_callXS is irssi_callXS from irssi **/
void arisa_callXS(void (*subaddr)(pTHX_ CV* cv), CV *cv, SV **mark) {
	dSP;

	PUSHMARK(mark);
	(*subaddr)(aTHX_ cv);

	PUTBACK;
}

static SV *ptr_to_sv(void *ptr) {
	SV *sv = newSViv((IV)ptr);
	return sv;
}

SV *create_ptr_object(const char *package, void *ptr) {
	HV *hv, *stash;
	
	if(ptr == NULL)
		return &PL_sv_undef;
	
	stash = gv_stashpv(package,0);
	if(stash == NULL) {
		LOGTP(L_ERR,"Unknown package: %s, during stash locate.",
				package);
		return NULL;
	}
	
	hv = newHV();
	hv_store(hv,"_ptr",4,ptr_to_sv(ptr),0);

	return sv_bless(newRV_noinc((SV*)hv),stash);
}

SV *create_ptr2_object(const char *package, ptr2_t *ptr) {
	HV *hv, *stash;

	if(ptr == NULL)
		return &PL_sv_undef;
	if(ptr->major == NULL || ptr->minor == NULL)
		return &PL_sv_undef;

	stash = gv_stashpv(package,0);
	if(stash == NULL) {
		LOGTP(L_ERR,"Unknown package: %s, during stash locate.",
				package);
		return NULL;
	}

	hv = newHV();
	hv_store(hv,"_major",6,ptr_to_sv(ptr->major),0);
	hv_store(hv,"_minor",6,ptr_to_sv(ptr->minor),0);

	return sv_bless(newRV_noinc((SV*)hv),stash);
}	

SV *create_ptr2_object_p(const char *package, void *major, void *minor) {
	ptr2_t ptr;
	ptr.major = major;
	ptr.minor = minor;
	return create_ptr2_object(package,&ptr);
}
	

/** fetch_object_ptr is based on irssi_ref_object from irssi **/ 
void *fetch_object_ptr(SV *o) {
        SV **sv;
	HV *hv;

        hv = hvref(o);
	if(hv == NULL)
		return NULL;

	sv = hv_fetch(hv,"_ptr",4,0);
	if(sv == NULL)
		croak("variable is damaged");
	return (void *)SvIV(*sv);
}

void fetch_object_ptr2(SV *o, ptr2_t *ptr) {
	SV **sv1, **sv2;
	HV *hv;

	ptr->major = NULL;
	ptr->minor = NULL;
	
	hv = hvref(o);
	if (hv == NULL)
		return;

	sv1 = hv_fetch(hv,"_major",6,0);
	sv2 = hv_fetch(hv,"_minor",6,0);
	if(sv1 == NULL || sv2 == NULL)
		croak("variable is damaged");
	
	ptr->major = (void *)SvIV(*sv1);
	ptr->minor = (void *)SvIV(*sv2);
}

static char *script_path_to_name(const char *path, 
		char *buffer, size_t bufsize) {
	int i;

	for(i = 0; path[i] != '\0' && i < (bufsize - 1); ++i) {
		if(isalnum(path[i]))
			buffer[i] = path[i];
		else
			buffer[i] = '_';
	}
	buffer[i] = '\0';

	return buffer;
}

/** perl_script_destroy_package is from irssi, slightly modified **/
static void perl_script_destroy_package(const char *package) {
	dSP;

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);

	XPUSHs(sv_2mortal(new_pv(package)));

	perl_call_pv("Arisa::Core::destroy", G_VOID|G_EVAL|G_DISCARD);

	SPAGAIN;

	PUTBACK;
	FREETMPS;
	LEAVE;
}

static void perl_script_destroy(const char *path) {
	char package[512], name[512];
	
	script_path_to_name(path,name,sizeof(name));
	snprintf(package,sizeof(package),"Arisa::Script::%s",name);
	
	perl_script_destroy_package(package);
}

static int perl_script_unload(plocal_t *l, const char *path) {
	int i,found;
	
	LOCK(l->interpreter);
	for(i = 0, found = -1; 
			i < l->interpreter->no_loaded && found == -1; ++i) {
		if(strcmp(l->interpreter->loaded[i],path) == 0)
			found = i;
	}
	if(found >= 0) {
		xfree(l->interpreter->loaded[found]);
		PTRARR_DEL(&(l->interpreter->loaded),
			&(l->interpreter->no_loaded),
			l->interpreter->loaded[found]);
		UNLOCK(l->interpreter);
		perl_script_destroy(path);
		LOGTP(L_INF,"Unloaded: %s",path);
	} else
		UNLOCK(l->interpreter);

	return (found < 0 ? -1 : 0);
}

/** perl_script_eval is from irssi, slightly modified **/
static int perl_script_eval(const char *path) {
	dSP;
	char name[512];
	char *error;
	int retcount;
	SV *ret;

	script_path_to_name(path,name,sizeof(name));
	
	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(sv_2mortal(new_pv(path)));
	XPUSHs(sv_2mortal(new_pv(name)));
	PUTBACK;

	retcount = perl_call_pv("Arisa::Core::eval_file",G_EVAL|G_SCALAR);
	SPAGAIN;

        error = NULL;
	if (SvTRUE(ERRSV)) {
		error = SvPV(ERRSV, PL_na);

		if (error != NULL) {
			LOGTP(L_ERR,"Script Error {\"%s\"}: %s",path,error);
			//free(error);
		}
	} else if (retcount > 0) {
		/* if script returns 0, it means the script wanted to unload
		   immediately without any error message */
		ret = POPs;
		if (ret != &PL_sv_undef && SvIOK(ret) && SvIV(ret) == 0)
			error = "";
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

        return (error == NULL ? 0 : -1);
}

static int perl_script_load(plocal_t *l, const char *path) {
	int i,found;
	int ret = -1;

	LOCK(l->interpreter);
	for(i = 0, found = -1;
			i < l->interpreter->no_loaded && found == -1; ++i) {
		if(strcmp(l->interpreter->loaded[i],path) == 0)
			found = i;
	}
	if(found == -1) {
		PTRARR_ADD(&(l->interpreter->loaded),
			&(l->interpreter->no_loaded),xstrdup(path));
		UNLOCK(l->interpreter);
		LOGTP(L_INF,"Loading: %s",path);
		if(perl_script_eval(path) == 0) {
			ret = 0;
			LOGTP(L_INF,"Loaded: %s",path);
		} else {
			perl_script_unload(l,path);
		}
	} else {
		UNLOCK(l->interpreter);
		LOGTP(L_ERR,"Tried to load script \"%s\", but script is already loaded.",path);
	}

	return ret;
}

static void emit_signal(plocal_t *l, HV *data) {
	dSP;

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newRV_noinc((SV*)data)));
	PUTBACK;

	perl_call_pv("Arisa::_signal", G_EVAL | G_SCALAR);

	SPAGAIN;

	if(SvTRUE(ERRSV)) {
		char *error = SvPV(ERRSV, PL_na);
		if (error != NULL)
			LOGTP(L_ERR,"Perl Error: %s",error);
	}

	PUTBACK;

	FREETMPS;
	LEAVE;
}

static void emit_script_signal(plocal_t *l, const char *type, 
		const char *path, time_t occured, const char *name) {
	HV *data = newHV();

	hv_store(data,"type",4,new_pv(type),0);
	hv_store(data,"occured",7,newSVuv(occured),0);
	hv_store(data,"path",4,new_pv(path),0);
	hv_store(data,"name",4,new_pv(name),0);

	emit_signal(l,data);
}

static void script_msg(plocal_t *l, se_msg_t *msg) {
	char name[512];

	script_path_to_name(msg->script.name,name,sizeof(name));

	if(msg->type == SE_UNLOAD || msg->type == SE_RELOAD) {
		emit_script_signal(l,"script unload",
				msg->script.name,msg->occured,name);
		perl_script_unload(l,msg->script.name);
	}

	if(msg->type == SE_LOAD || msg->type == SE_RELOAD) {
		emit_script_signal(l,"script load",
				msg->script.name,msg->occured,name);
		if(perl_script_load(l,msg->script.name) == 0)
			emit_script_signal(l,"script loaded",
					msg->script.name,xtime(),name);
	}	
}

static const char *signal_names[] = {
	"unknown",			// SE_UNKNOWN
	"script load",			// SE_LOAD
	"script unload",		// SE_UNLOAD
	"script reload",		// SE_RELOAD
	"shutdown",			// SE_RELOAD
	"irc msg",			// SE_IRC_MSG
	"send notification",		// SE_SEND_NOTIFICATION
	"recv notification",		// SE_RECV_NOTIFICATION
	"queue enqueue",		// SE_QUEUE_ENQUEUE
	"queue dequeue",		// SE_QUEUE_DEQUEUE
	"pack add",			// SE_PACK_ADD
	"pack del",			// SE_PACK_DEL
	"pack hashed",			// SE_PACK_HASHED
	"packlist add",			// SE_PACKLIST_ADD
	"ui call",			// SE_UI_CALL
	"external signal",		// SE_SIGNAL
	"interface add",		// SE_INTERFACE_ADD
	"pool add",			// SE_POOL_ADD
	"queue add",			// SE_QUEUE_ADD
	"network add",			// SE_NETWORK_ADD
	"channel add",			// SE_CHANNEL_ADD
	"user add",			// SE_USER_ADD
	"admin logon",			// SE_ADMIN_LOGON
	"admin logoff",			// SE_ADMIN_LOGOFF
	"save data",			// SE_SAVE_DATA
	"load data"			// SE_LOAD_DATA
};

static HV *build_signal(se_msg_t *msg) {
	HV *data = newHV();
	AV *tmp;
	int i;

	if(msg->type < (sizeof(signal_names)/sizeof(char *)))
		hv_store(data,"type",4,new_pv(signal_names[msg->type]),0);
	else
		hv_store(data,"type",4,new_pv(signal_names[SE_UNKNOWN]),0);
	hv_store(data,"occured",7,newSVuv(msg->occured),0);
	
	switch(msg->type) {
		case SE_IRC_MSG:
			hv_store(data,"network",7,create_ptr_object("Arisa::Network",msg->irc.network),0);
			tmp = newAV();
			for(i = 0; i < msg->irc.no_data; ++i)
				av_push(tmp,new_pv(msg->irc.data[i]));
			hv_store(data,"data",4,newRV_noinc((SV*)tmp),0);
			break;
		case SE_SEND_NOTIFICATION:
		case SE_RECV_NOTIFICATION:
		case SE_QUEUE_ENQUEUE:
		case SE_QUEUE_DEQUEUE:
			if(msg->notification.interface != NULL)
				hv_store(data,"interface",9,create_ptr_object("Arisa::Interface",msg->notification.interface),0);
			if(msg->notification.pool != NULL)
				hv_store(data,"pool",4,create_ptr2_object_p("Arisa::Pool",msg->notification.pool,msg->notification.interface),0);
			if(msg->notification.queue != NULL)
				hv_store(data,"queue",5,create_ptr_object("Arisa::Queue",msg->notification.queue),0);
			hv_store(data,"send",4,newRV_noinc((SV*)send_to_hv(msg->notification.send)),0);
			if(msg->type == SE_QUEUE_ENQUEUE || SE_QUEUE_DEQUEUE)
				hv_store(data,"queue_position",14,newSViv(msg->notification.aux),0);
			else
				hv_store(data,"errno",5,newSViv(msg->notification.aux),0);
			break;
		case SE_PACK_ADD:
		case SE_PACK_DEL:
		case SE_PACK_HASHED:
		case SE_PACKLIST_ADD:
			if(msg->pack.list != NULL)
				hv_store(data,"packlist",8,create_ptr_object("Arisa::Packlist",msg->pack.list),0);
			if(msg->pack.pack != NULL)
				hv_store(data,"pack",4,newRV_noinc((SV*)pack_to_hv(msg->pack.pack)),0);
			break;
		case SE_SIGNAL:
			hv_store(data,"name",4,new_pv(msg->signal.name),0);
			break;
		case SE_INTERFACE_ADD:
		case SE_POOL_ADD:
			hv_store(data,"interface",9,create_ptr_object("Arisa::Interface",msg->interface.interface),0);
			if(msg->interface.pool != NULL)
				hv_store(data,"pool",4,create_ptr2_object_p("Arisa::Pool",msg->interface.pool,msg->interface.interface),0);
			break;
		case SE_QUEUE_ADD:
			hv_store(data,"queue",5,create_ptr_object("Arisa::Queue",msg->queue.queue),0);
			break;
		case SE_NETWORK_ADD:
		case SE_CHANNEL_ADD:
			hv_store(data,"network",8,create_ptr_object("Arisa::Network",msg->network.network),0);
			if(msg->network.channel != NULL)
				hv_store(data,"channel",8,create_ptr2_object_p("Arisa::Channel",msg->network.channel,msg->network.network),0);
			break;
		case SE_USER_ADD:
			hv_store(data,"user",4,create_ptr_object("Arisa::User",msg->user.user),0);
			break;
		case SE_ADMIN_LOGON:
		case SE_ADMIN_LOGOFF:
			if(msg->admin.admin != NULL)
				hv_store(data,"admin",5,create_ptr_object("Arisa::Admin",msg->admin.admin),0);
			hv_store(data,"user",4,create_ptr_object("Arisa::User",msg->admin.user),0);
			break;
		default:
			break;
	}
	
	return data;
}

static void emit_load(plocal_t *l, uint8_t *data, size_t data_len) {
	dSP;

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSVpv((char *)data,data_len)));
	PUTBACK;

	perl_call_pv("Arisa::_settings_load", G_EVAL | G_SCALAR);

	SPAGAIN;

	if(SvTRUE(ERRSV)) {
		char *error = SvPV(ERRSV, PL_na);
		if (error != NULL)
			LOGTP(L_ERR,"Perl Error: %s",error);
	}

	PUTBACK;

	FREETMPS;
	LEAVE;
}

static void emit_save(plocal_t *l, uint8_t **data, size_t *data_len) {
	dSP;
	int retcount;

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSViv(0)));
	PUTBACK;
	
	retcount = perl_call_pv("Arisa::_settings_data", G_EVAL | G_SCALAR);

	//D("retcount: %d",retcount);
	
	SPAGAIN;

	if(SvTRUE(ERRSV)) {
		char *error = SvPV(ERRSV, PL_na);
		if (error != NULL)
			LOGTP(L_ERR,"Perl Error: %s",error);
	} else if(retcount > 0) {
		SV *ret = POPs;
		if(ret != &PL_sv_undef && SvPOK(ret)) {
			STRLEN len;
			char *tmp = SvPV(ret,len);
			//D("tmp = %p \"%s\", len = %d",tmp,tmp,len);
			if(tmp != NULL && len > 0) {
				*data_len = len;
				*data = xalloc(len);
				memcpy(*data,tmp,len);
			} else {
				*data_len = 0;
				*data = NULL;
			}
		}
	}

	PUTBACK;

	FREETMPS;
	LEAVE;
}

void load_save_msg(plocal_t *l, se_msg_t *msg) {
	if(msg->type == SE_LOAD_DATA) {
		emit_load(l,msg->load.data,msg->load.size);
	} else /* msg->type == SE_SAVE_DATA */ {
		HV *data = newHV();
		hv_store(data,"type",4,new_pv(signal_names[msg->type]),0);
		hv_store(data,"occured",7,newSVuv(msg->occured),0);
		emit_signal(l,data);
		LOCKR(&msg->save.lock);
		emit_save(l,&(msg->save.data),&(msg->save.size));
		pthread_cond_signal(&(msg->save.cond));
		UNLOCKR(&msg->save.lock);
	}	
}

void perl_handle_msg(plocal_t *l, se_msg_t *msg) {
	HV *data = NULL;
	
	switch (msg->type) {
		case SE_LOAD:
		case SE_RELOAD:
		case SE_UNLOAD:
			script_msg(l,msg);
			break;
		case SE_UI_CALL:
			perl_handle_ui_call(l,msg);
			break;
		case SE_SAVE_DATA:
		case SE_LOAD_DATA:
			load_save_msg(l,msg);
			break;
		default:
			data = build_signal(msg);
			break;
	}

	if(data != NULL)
		emit_signal(l,data);
}


void perl_handle_log_msg(plocal_t *l, char *msg) {
	time_t *occured = (time_t *)(strchr(msg,'\0')+1);
	HV *data = newHV();

	hv_store(data,"type",4,new_pv("log msg"),0);
	hv_store(data,"occured",7,newSVuv(*occured),0);
	hv_store(data,"msg",3,new_pv(msg),0);

	emit_signal(l,data);
}

void init_perl(plocal_t *l) {
	unsigned long size;
	char *args[] = {"", "-e", "0"};
	char *code;
	
	l->my_perl = perl_alloc();
	perl_construct(l->my_perl);

	perl_parse(l->my_perl, xs_init, 3, args, NULL);
	perl_eval_pv("Arisa::Core::boot_Arisa_Core();", TRUE);
	
	/* load arisa-core.pl */
	
	size = arisa_core_code_original_size + 16;
	code = xalloc(size);

	if(uncompress(code,&size,
			arisa_core_code_data,arisa_core_code_size) != Z_OK) {
		LOGTP(L_ERR,"Error decompressing Perl core code.");
		xfree(code);
		return;
	}
	
	code[size] = '\0';
	perl_eval_pv(code, TRUE);

	xfree(code);

	/* load all the .pm's */
	size = perl_modules_original_size + 16;
	code = xalloc(size);

	if(uncompress(code,&size,
			perl_modules_data,perl_modules_size) != Z_OK) {
		LOGTP(L_ERR,"Error decompressing Perl modules code.");
		xfree(code);
		return;
	}

	code[size] = '\0';
	perl_eval_pv(code, TRUE);

	xfree(code);
}

void deinit_perl(plocal_t *l) {
	char **scripts;
	int i, no_scripts;
	
	if(l->my_perl == NULL)
		return;

	LOCK(l->interpreter);
	scripts = strarr_dup(l->interpreter->loaded,
			l->interpreter->no_loaded,&no_scripts);
	UNLOCK(l->interpreter);
	for(i = 0; i < no_scripts; ++i)
		perl_script_unload(l,scripts[i]);
	strarr_free(&scripts,&no_scripts);
	
	/* Unload all perl libraries loaded with dynaloader */
	perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Arisa\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE);

	perl_destruct(l->my_perl);
	perl_free(l->my_perl);
	l->my_perl = NULL;
}

void perl_tick(plocal_t *l, struct timeval *now) {
	dSP;
	
	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	XPUSHs(sv_2mortal(newSViv(now->tv_sec)));
	XPUSHs(sv_2mortal(newSViv(now->tv_usec)));
	PUTBACK;

	perl_call_pv("Arisa::_tick", G_EVAL | G_SCALAR);

	SPAGAIN;

	if (SvTRUE(ERRSV)) {
		char *error = SvPV(ERRSV, PL_na);
		
		if (error != NULL)
			LOGTP(L_ERR,"Perl Error: %s",error);
	}
	
	PUTBACK;
	
	FREETMPS;
	LEAVE;
}

void hv_store_values(HV *hv, pqueue_t *values) {
	value_t *v;

	while((v = pqueue_pop_front(values)) != NULL) {
		char *name = v->name;
		size_t namelen = strlen(name);
		
		if(v->flags & VALUE_STRING || v->flags & VALUE_ENUM) {
			char *value = value_as_string(v,VALUE_ALLOW_NULL,
					NULL,0,NULL);
			hv_store(hv,name,namelen,new_pv(value),0);
			if(value != NULL)
				xfree(value);
		} else if(v->flags & VALUE_INT32) {
			if(v->flags & VALUE_UNSIGNED) {
				hv_store(hv,name,namelen,
					newSVuv(value_as_uint32(v,0,0,0,0)),0);
			} else { 
				hv_store(hv,name,namelen,
					newSViv(value_as_int32(v,0,0,0,0)),0);
			}
		} else if(v->flags & VALUE_DOUBLE || v->flags & VALUE_INT64) {
			hv_store(hv,name,namelen,
				newSVnv(value_as_double(v,0,0.0,0.0,0.0)),0);
		}
		
		xfree(v);
	}
}

AV *strarr_to_av(char **strs, int no_strs) {
	AV *av = newAV();
	int i;

	for(i = 0; i < no_strs; ++i)
		av_push(av,new_pv(strs[i]));

	return av;
}

void av_to_strarr(char ***strs, int *no_strs, SV *sv) {
	STRLEN n_a;
	AV *av;
	int i;
	
	if(sv == NULL)
		return;
	if(SvTYPE(sv) == SVt_RV)
		sv = SvRV(sv);
	if(SvTYPE(sv) != SVt_PVAV)
		return;
	
	av = (AV *)sv;
	
	strarr_free(strs,no_strs);
	for(i = 0; i < av_len(av); ++i) {
		SV *v = *(av_fetch(av,i,0));
		char *str = SvPV(v, n_a);
		if(str != NULL)
			PTRARR_ADD(strs,no_strs,xstrdup(str));
	}
}

HV *pack_to_hv(pack_t *p) {
	HV *hv = newHV();
	hv_store(hv,"_ptr",4,ptr_to_sv(p),0);
	hv_store(hv,"size",4,newSVnv((double)p->size),0);
	hv_store(hv,"file",4,new_pv(p->file),0);
	hv_store(hv,"label",5,new_pv(p->label),0);
	if(p->hashed) {
		hv_store(hv,"hashed",6,newSVuv(p->hashed),0);
		hv_store(hv,"md5",3,new_pv(p->md5),0);
		hv_store(hv,"crc",3,new_pv(p->crc),0);
	}
	hv_store(hv,"no_gets",7,newSViv(p->no_gets),0);
	return hv;
}

HV *chat_to_hv(chat_t *c) {
	HV *hv = newHV();

	hv_store(hv,"_ptr",4,ptr_to_sv(c),0);
	
	hv_store(hv,"type",4,new_pv(chattype_to_str(c->type)),0);
	hv_store(hv,"colour",6,new_pv(colourtype_to_str(c->colour)),0);
	hv_store(hv,"state",5,new_pv(state_to_str(c->state)),0);
	
	hv_store(hv,"nick",4,new_pv(c->nick),0);
	hv_store(hv,"network",7,
		create_ptr_object("Arisa::Network",c->network),0);
	hv_store(hv,"host",4,new_pv(c->host),0);
	hv_store(hv,"hostmask",8,new_pv(c->hostmask),0);

	hv_store(hv,"started",7,newSVuv(c->started),0);
	hv_store(hv,"connected",9,newSVuv(c->connected),0);
	hv_store(hv,"last_contact",12,newSVuv(c->last_contact),0);

	if(c->reason != NULL)
		hv_store(hv,"reason",6,new_pv(c->reason),0);
	
	if(c->type == CHAT_ADMIN) {
		hv_store(hv,"user",4,
			create_ptr_object("Arisa::User",c->admin.user),0);
	} else if(c->type == CHAT_LIST) {
		hv_store(hv,"commands",8,newSViv(c->list.commands),0);
		hv_store(hv,"packlist",8,
			create_ptr_object("Arisa::Packlist",c->list.packlist),0);
	}
	
	return hv;
}

HV *send_to_hv(send_t *s) {
	uint64_t speed;
	HV *hv = newHV();
	AV *avgspeed = newAV();
	int i;
	
	hv_store(hv,"_ptr",4,ptr_to_sv(s),0);
	
	hv_store(hv,"pack",4,s->pack != NULL ? 
		newRV_noinc((SV*)pack_to_hv(s->pack)) : &PL_sv_undef,0);
	
	hv_store(hv,"host",4,new_pv(s->host),0);
	hv_store(hv,"nick",4,new_pv(s->nick),0);
	hv_store(hv,"network",7,
		create_ptr_object("Arisa::Network",s->network),0);
	
	hv_store(hv,"state",5,new_pv(state_to_str(s->state)),0);

	hv_store(hv,"retries",7,newSViv(s->retries),0);
	if(s->queue != NULL) {
		hv_store(hv,"queue",5,
			create_ptr_object("Arisa::Queue",s->queue),0);
	}
	
	hv_store(hv,"started",7,newSVuv(s->started),0);
	hv_store(hv,"connected",9,newSVuv(s->connected),0);
	hv_store(hv,"last_contact",12,newSVuv(s->last_contact),0);

	for(i = 0, speed = 0; i < AVGSPEED; ++i) {
		speed += s->avgspeed[i];
		av_push(avgspeed,newSVuv(s->avgspeed[i]));
	}
	hv_store(hv,"speed",5,
		newSVuv((unsigned int)(speed / (uint64_t)AVGSPEED)),0);
	hv_store(hv,"speed_data",10,newRV_noinc((SV*)avgspeed),0);

	hv_store(hv,"position",8,newSVnv((double)s->pos),0);
	hv_store(hv,"bytes_sent",10,newSVnv((double)s->bytes_sent),0);

	if(s->reason != NULL)
		hv_store(hv,"reason",6,new_pv(s->reason),0);
	
	return hv;
}

HV *access_entry_to_hv(access_entry_t *ent) {
	char mode[8];
	HV *hv = newHV();
	int i;
	
	hv_store(hv,"_ptr",4,ptr_to_sv(ent),0);
	
	hv_store(hv,"type",4,new_pv(ent->flags & ACCESS_ALLOW ? "ALLOW" : "DENY"),0);
	hv_store(hv,"network",7,create_ptr_object("Arisa::Network",ent->network),0);
	hv_store(hv,"channel",7,create_ptr2_object_p("Arisa::Channel",ent->channel,ent->network),0);
	hv_store(hv,"host",4,new_pv(ent->host),0);

	i = 0;
	if(ent->mode & MODE_OP)
		mode[i++] = 'o';
	if(ent->mode & MODE_VOICE)
		mode[i++] = 'v';
	if(ent->mode & MODE_HOP)
		mode[i++] = 'h';
	mode[i] = '\0';

	hv_store(hv,"mode",4,new_pv(mode),0);

	return hv;
}

HV *ignore_entry_to_hv(ignore_entry_t *ent) {
	HV *hv = newHV();
	
	hv_store(hv,"mask",4,new_pv(ent->mask),0);
	hv_store(hv,"expires",7,newSVuv(ent->expires),0);
	if(ent->flags & IGNORE_FOREVER)
		hv_store(hv,"forever",7,newSViv(1),0);
	if(ent->flags & IGNORE_INVERSION)
		hv_store(hv,"inversion",9,newSViv(1),0);

	return hv;
}

SV *getSVarg(SV **sp, SV **mark, I32 ax, I32 items, const char *name) {
	int shift = 0;
	
	if(items > 0) {
		SV *sv0 = ST(0);
		if(SvTYPE(sv0) == SVt_RV || SvTYPE(sv0) == SVt_PVHV) {
			HV *stash = NULL;
			if(SvTYPE(sv0) == SVt_RV) {
				HV *hvp = hvref(sv0);
				if(hvp != NULL)
					stash = SvSTASH(hvp);
			} else {
				stash = SvSTASH(sv0);
			}
			if(stash != NULL) {
				char *name;
				if((name = HvNAME(stash)) != NULL) {
					if(strncmp(name,"Arisa::",7) == 0)
						shift = 1;
				}
			}
		}
	}
	
	if(((items - shift) % 2) == 0) {
		STRLEN n_a;
		char *arg_name;
		int i;
		for(i = shift; i < items; i += 2) {
			arg_name = (char *) SvPV(ST(i),n_a);
			if(strcmp(name,arg_name) == 0)
				return ST(i+1);
		}
	} else if((items - shift) > 0) {
		HV *hv = hvref(ST(shift));
		if(hv != NULL) {
			SV **ret = hv_fetch(hv,name,strlen(name),0);
			if(ret != NULL) {
				//SvREFCNT_dec(*ret);
				return *ret;
			}
		}
	}

	return NULL;
}

int getSvIVarg(SV **sp, SV **mark, I32 ax, I32 items, const char *name) {
	SV *sv = getSVarg(sp,mark,ax,items,name);
	if(sv != NULL)
		return SvIV(sv);
	else
		return 0;
}

unsigned int getSvUVarg(SV **sp, SV **mark, I32 ax, I32 items, const char *name) {
	SV *sv = getSVarg(sp,mark,ax,items,name);
	if(sv != NULL)
		return SvIV(sv);
	else
		return 0;
}

char *getSvPVarg(SV **sp, SV **mark, I32 ax, I32 items, const char *name) {
	STRLEN n_a;
	SV *sv = getSVarg(sp,mark,ax,items,name);
	if(sv != NULL)
		return (char *)SvPV(sv,n_a);
	else
		return NULL;
}

SV *perl_access_add(SV **sp, SV **mark, I32 ax, I32 items, access_t *acc) {
	network_t *net	= SvPTRarg("network");
	channel_t *chan	= NULL;
	char *host	= SvPVarg("host");
	char *type	= SvPVarg("type");
	int mode	= mode_from_str(SvPVarg("mode"));
	int flags	= ACCESS_ALLOW;
	SV *tmp 	= SVarg("channel");

	if(tmp != NULL) {
		ptr2_t ptr;
		fetch_object_ptr2(tmp,&ptr);
		net	= ptr.minor;
		chan	= ptr.major;
	}
	if(type != NULL) {
		if(strcasecmp(type,"deny") == 0)
			flags = ACCESS_DENY;
	}
	if(net != NULL || chan != NULL || host != NULL || mode != 0) {
		if(access_add_entry(acc,flags,net,host,chan,mode) == 0)
			return &PL_sv_yes;
	}
	
	return &PL_sv_no;
}

SV *perl_access_check(SV **sp, SV **mark, I32 ax, I32 items, access_t *acc) {
	network_t *net	= SvPTRarg("network");
	channel_t *chan	= NULL;
	char *host	= SvPVarg("host");
	char *hostmask	= SvPVarg("hostmask");
	char *nick	= SvPVarg("nick");
	int ok		= 1;
	SV *tmp;

	tmp = SVarg("channel");
	if(tmp != NULL) {
		ptr2_t ptr;
		fetch_object_ptr2(tmp,&ptr);
		net	= ptr.minor;
		chan	= ptr.major;
	}
	
	if(ok && net != NULL)
		ok &= irc_network_valid(net);
	if(ok && chan != NULL)
		ok &= irc_channel_valid(net,chan);
	
	if(ok) {
		int ret = -1;
		if(nick != NULL || chan == NULL)
			ret = access_check(acc,net,host,hostmask,nick);
		else
			ret = access_check_channel(acc,net,chan);
		if(ret == 0)
			return &PL_sv_yes;
	}
	
	return &PL_sv_no;
}

SV *perl_access_del(SV **sp, SV **mark, I32 ax, I32 items, access_t *acc) {
	void *ptr;
	
	if(items == 2) {
		if(SvTYPE(ST(1)) == SVt_IV) {
			int no = SvIV(ST(1));
			if(access_del_entry_no(acc,no) == 0)
				return &PL_sv_yes;
		}
	}
	
	ptr = (void *)SvIVarg("_ptr");
	if(access_del_entry(acc,ptr) == 0)
		return &PL_sv_yes;

	return &PL_sv_no;
}

SV *perl_access_mode(SV **sp, SV **mark, I32 ax, I32 items, access_t *acc) {
	SV *RETVAL = &PL_sv_undef;
	LOCK(acc);
	if(items > 2) {
		STRLEN n_a;
		char *var = (char *)SvPV(ST(1), n_a);
		switch(tolower(var[0])) {
			case 'a':
				acc->flags = ACCESS_ALLOW;
				break;
			case 'd':
				acc->flags = ACCESS_DENY;
				break;
			case 's':
				acc->flags = ACCESS_SMART;
				break;
		}
	}
	if((acc->flags & ACCESS_SMART) == ACCESS_SMART) {
		RETVAL = new_pv("smart");
	} else if(acc->flags & ACCESS_ALLOW) {
		RETVAL = new_pv("allow, deny");
	} else {
		RETVAL = new_pv("deny, allow");
	}
	UNLOCK(acc);

	return RETVAL;
}


SV *perl_ignore_add(SV **sp, SV **mark, I32 ax, I32 items, ignore_list_t *l) {
	char *mask	= SvPVarg("mask");
	time_t expires	= SvUVarg("expires");
	int inversion	= SvIVarg("inversion");
	int flags	= 0;

	if(expires == 0)
		flags |= IGNORE_FOREVER;
	if(inversion)
		flags |= IGNORE_INVERSION;
	if(ignore_add(l,mask,flags,expires) == 0)
		return &PL_sv_yes;
	
	return &PL_sv_no;
}

SV *perl_ignore_del(SV **sp, SV **mark, I32 ax, I32 items, ignore_list_t *l) {
	char *mask = SvPVarg("mask");
	if(mask != NULL) {
		if(ignore_del(l,-1,mask) == 0)
			return &PL_sv_yes;
	}
	return &PL_sv_no;
}

HV *perl_ignore_settings(SV **sp, SV **mark, I32 ax, I32 items, 
		ignore_list_t *l) {
	HV *hv = newHV();
	
	LOCK(l);
	if(items > 1) {
		int trigger = SvIVarg("trigger");
		int period = SvIVarg("period");
		if(trigger >= 0)
			l->trigger = trigger;
		if(period >= 0)
			l->period = period;
	}
	hv_store(hv,"trigger",7,newSViv(l->trigger),0);
	hv_store(hv,"period",6,newSViv(l->period),0);
	UNLOCK(l);
	
	return hv;
}

SV *perl_ignore_move(ignore_list_t *l, int src, int dst) {
	SV *RETVAL = &PL_sv_no;
	LOCK(l);
	if(PTRARR_MOVE(&(l->entries),&(l->no_entries),src,dst) == 0)
		RETVAL = &PL_sv_yes;
	UNLOCK(l);
	return RETVAL;
}