#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "perliol.h"

#include "ppport.h"

#define READING(fp, fail) do{\
		if( !(PerlIOBase(fp)->flags & PERLIO_F_CANREAD) ) return (fail);\
	} while(0)
#define WRITING(fp, fail) do{\
		if( !(PerlIOBase(fp)->flags & PERLIO_F_CANWRITE)) return (fail);\
		PerlIOBase(fp)->flags &= ~PERLIO_F_RDBUF;\
	} while(0)

#define IOC(f) (PerlIOSelf((f), PerlIOCode))


typedef struct{
	struct _PerlIO base;
	CV* cv;
	SV* arg;


	SV* buf;
	Off_t offset;
} PerlIOCode;


static PerlIO*
PerlIOCode_open(pTHX_ PerlIO_funcs *tab,
			PerlIO_list_t *layers, IV n, const char *mode,
			int fd, int imode, int perm,
			PerlIO *f, int narg, SV **args){
	PERL_UNUSED_ARG(layers);
	PERL_UNUSED_ARG(n);
	PERL_UNUSED_ARG(fd);
	PERL_UNUSED_ARG(imode);
	PERL_UNUSED_ARG(perm);

	/* 0 < narg < 3 */
	assert(narg > 0);
	if(narg > 2){
		/* too many arguments */
		SETERRNO(EINVAL, LIB_INVARG);
		return NULL;
	}

	if(f){
		PerlIO_close(f);
	}
	else{
		f = PerlIO_allocate(aTHX);
	}

	if ( (f = PerlIO_push(aTHX_ f, tab, mode, args[0])) ) {
		PerlIOBase(f)->flags |= PERLIO_F_OPEN;

		if(narg == 2){
			IOC(f)->arg = SvREFCNT_inc_simple_NN(args[1]);
		}
	}
	return f;
}

static IV
PerlIOCode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * tab){
	PerlIOCode* ioc = IOC(f);

	if(arg && SvOK(arg)){
		HV* stash;
		GV* gv;
		ioc->cv = sv_2cv(arg, &stash, &gv, TRUE);

		assert(ioc != NULL);
/*
		if(ioc->cv == NULL){
			SETERRNO(ENOENT,RMS_FNF);
			return NULL;
		}
*/
		SvREFCNT_inc_simple_void_NN(ioc->cv);
	}
	else{
		SETERRNO(EINVAL, LIB_INVARG);
		return -1; /* fail */
	}

	ioc->buf = newSVpvs("");
	ioc->offset = 0;

	return PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab);
}

static IV
PerlIOCode_popped(pTHX_ PerlIO * f){
	PerlIOCode *ioc = IOC(f);

	SvREFCNT_dec(ioc->cv);
	ioc->cv = Nullcv;

	SvREFCNT_dec(ioc->buf);
	ioc->buf = Nullsv;

	SvREFCNT_dec(ioc->arg);
	ioc->arg = Nullsv;

	return PerlIOBase_popped(aTHX_ f);
}


static SSize_t
PerlIOCode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count){
	dVAR; dSP;

	PerlIOCode* ioc = IOC(f);

	WRITING(f, -1);

	PUSHMARK(SP);
	if(ioc->arg) XPUSHs(ioc->arg);
	sv_setpvn(ioc->buf, vbuf, count);
	XPUSHs(ioc->buf);
	PUTBACK;

	call_sv((SV*)ioc->cv, G_VOID | G_DISCARD);

	return count;
}

static IV
PerlIOCode_fill(pTHX_ PerlIO* f){
	dVAR; dSP;
	PerlIOCode* ioc = IOC(f);
	SV* result;

	READING(f, -1);

	if(PerlIOBase(f)->flags & PERLIO_F_EOF){
		return -1;
	}

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	if(ioc->arg){
		XPUSHs(ioc->arg);
		PUTBACK;
	}

	call_sv((SV*)ioc->cv, G_SCALAR);

	SPAGAIN;
	result = POPs;
	PUTBACK;

	if(SvOK(result)){
		sv_copypv(ioc->buf, result);
		PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
	}
	else{
		PerlIOBase(f)->flags |= PERLIO_F_EOF;
		PerlIOBase(f)->flags &= ~PERLIO_F_RDBUF;
		sv_setpvn(ioc->buf, "", 0);
	}

	ioc->offset = 0;

	FREETMPS;
	LEAVE;

	return SvCUR(ioc->buf) ? 0 : -1;
}

static STDCHAR*
PerlIOCode_get_base(pTHX_ PerlIO* f){
	return (STDCHAR*)SvPVX(IOC(f)->buf);
}

static Size_t
PerlIOCode_bufsiz(pTHX_ PerlIO* f){
	return SvCUR(IOC(f)->buf);
}

static STDCHAR*
PerlIOCode_get_ptr(pTHX_ PerlIO* f){
	return (STDCHAR*)SvPVX(IOC(f)->buf) + IOC(f)->offset;
}

static SSize_t
PerlIOCode_get_cnt(pTHX_ PerlIO* f){
	return SvCUR(IOC(f)->buf) - IOC(f)->offset;
}

static void
PerlIOCode_set_ptrcnt(pTHX_ PerlIO* f, STDCHAR* ptr, SSize_t cnt){
	PERL_UNUSED_ARG(ptr);

	IOC(f)->offset = SvCUR(IOC(f)->buf) - cnt;
}

PERLIO_FUNCS_DECL(PerlIO_code) = {
	sizeof(PerlIO_funcs),
	"Code",
	sizeof(PerlIOCode),
	PERLIO_K_BUFFERED | PERLIO_K_RAW | PERLIO_K_MULTIARG,
	PerlIOCode_pushed,
	PerlIOCode_popped,
	PerlIOCode_open,
	PerlIOBase_binmode,
	NULL,
	NULL,
	NULL,
	NULL,
	NULL,
	PerlIOCode_write,
	NULL,
	NULL,
	NULL,
	NULL,
	PerlIOCode_fill,
	NULL,
	NULL,
	NULL,
	NULL,
	PerlIOCode_get_base,
	PerlIOCode_bufsiz,
	PerlIOCode_get_ptr,
	PerlIOCode_get_cnt,
	PerlIOCode_set_ptrcnt
};


MODULE = PerlIO::code		PACKAGE = PerlIO::code		

PROTOTYPES: DISABLE

BOOT:
	PerlIO_define_layer(aTHX_ &PerlIO_code);