#include <stdlib.h>
#include <string.h>
#include <stdio.h>

#include "../src/mlp_priv.h"
#include "mlp_perl_priv.h"


void *_mlp_perl_new_object(mlp_context *ctx, const mlp_class *class_, 
        int nb_args, const mlp_value **args){

	PerlInterpreter *my_perl = mlp_context_get_runtime(ctx)->runtime ;
	SV *obj = NULL ;

	dSP ;
	ENTER ;
	SAVETMPS ;

	PUSHMARK(SP) ;
	XPUSHs(sv_2mortal(newSVpv(class_->name, 0))) ;
	int i = 0 ;
	for (i = 0 ; i < nb_args ; i++){
		SV *sv = mlp_perl_make_SV(ctx, args[i]) ;
		if (mlp_context_has_error(ctx)){
			return NULL ;
		}
		XPUSHs(sv) ;
	}
	PUTBACK ;

	int count = call_method("new", G_SCALAR | G_EVAL) ;

	SPAGAIN ;

    if (SvTRUE(ERRSV)){
		/* TODO: Deal with the exception and return it to the caller */
        STRLEN n_a ;
		mlp_context_set_error(ctx, MLP_NO_SUCH_FUNCTION, "Error creating Perl object: %s",
			SvPV(ERRSV, n_a)) ;
        return NULL ;
    }
	else if (count != 1){
		mlp_context_set_error(ctx, MLP_INVALID_RETURN_VALUE, "Perl function must return 1 value (not %d)", count) ;
        return NULL ;
	}

	obj = newRV_inc(SvRV(POPs)) ;
	mlp_debug(5, "refcnt=%d", SvREFCNT(obj)) ;

	FREETMPS ;
	LEAVE ;

	return obj ;
}


mlp_value *_mlp_perl_call_method(mlp_context *ctx, const mlp_object *object, const char *name, 
	int nb_args, const mlp_value **args, mlp_type return_type){

	PerlInterpreter *my_perl = mlp_context_get_runtime(ctx)->runtime ;
	mlp_value *ret = NULL ;

	dSP ;
	ENTER ;
	SAVETMPS ;

	PUSHMARK(SP) ;
	XPUSHs((SV *)object->object) ;
	int i = 0 ;
	for (i = 0 ; i < nb_args ; i++){
		SV *sv = mlp_perl_make_SV(ctx, args[i]) ;
		if (mlp_context_has_error(ctx)){
			return NULL ;
		}
		XPUSHs(sv) ;
	}
	PUTBACK ;

	int count = call_method(name, G_SCALAR | G_EVAL) ;

	SPAGAIN ;

    if (SvTRUE(ERRSV)){
		/* TODO: Deal with the exception and return it to the caller */
        STRLEN n_a ;
		mlp_context_set_error(ctx, MLP_NO_SUCH_FUNCTION, "Error calling method %s: %s",
			name, SvPV(ERRSV, n_a)) ;
        return NULL ;
    }
	else if (count != 1){
		mlp_context_set_error(ctx, MLP_INVALID_RETURN_VALUE, "Perl method must return 1 value (not %d)", count) ;
        return NULL ;
	}

	STRLEN n_a ;
	/* TODO: Use return_type to return the correct type */
	ret = mlp_new_string_value(ctx, POPpx) ;
	mlp_debug_value(ret, "perl ret") ;

	FREETMPS ;
	LEAVE ;

	return ret ;
}


void _mlp_perl_detach_object(mlp_context *ctx, const mlp_object *object){
	PerlInterpreter *my_perl = mlp_context_get_runtime(ctx)->runtime ;

	SvREFCNT_dec((SV *)object->object) ;
}


void _mlp_perl_delete_object(mlp_context *ctx, const mlp_object *object){
	_mlp_perl_detach_object(ctx, object) ;
}