#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/*
#include "stdlib.h"
#include "string.h"
#include "stdio.h"
#include "stdarg.h"
*/
#ifdef __CYGWIN__
        #include "w32api/basetyps.h"
#endif
/* Include the JNI header file */
#include "jni.h"
void throw_ije(JNIEnv *env, char *msg){
        jclass ije ;
        ije = (*(env))->FindClass(env, "org/perl/inline/java/InlineJavaException") ;
        if ((*(env))->ExceptionCheck(env)){
                (*(env))->ExceptionDescribe(env) ;
                (*(env))->ExceptionClear(env) ;
                (*(env))->FatalError(env, "Can't find class InlineJavaException: exiting...") ;
        }
        (*(env))->ThrowNew(env, ije, msg) ;
}
/*
        Here we simply check if an exception is pending an re-throw it
*/
int check_exception_from_java(JNIEnv *env){
        jthrowable exc ;
        int ret = 0 ;
        exc = (*(env))->ExceptionOccurred(env) ;
        if (exc != NULL){
                /* (*(env))->ExceptionDescribe(env) ; */
                (*(env))->ExceptionClear(env) ;
                if ((*(env))->Throw(env, exc)){
                        (*(env))->FatalError(env, "Throw of InlineJava*Exception failed: exiting...") ;
                }
                ret = 1 ;
        }
        return ret ;
}
jobject create_primitive_object(JNIEnv *env, char f, char *cls_name, jvalue val){
        jclass arg_cls ;
        jmethodID mid ;
        jobject ret = NULL ;
        char sign[64] ;
        arg_cls = (*(env))->FindClass(env, cls_name) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        sprintf(sign, "(%c)V", f) ;
        mid = (*(env))->GetMethodID(env, arg_cls, "<init>", sign) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        ret = (*(env))->NewObjectA(env, arg_cls, mid, &val) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        return ret ;
}
jobject extract_va_arg(JNIEnv *env, va_list *list, char f){
        jobject ret = NULL ;
        jvalue val ;
        /*
                A bit of voodoo going on for J and F, but the rest I think is pretty
                kosher (on a 32 bit machine at least...)
        */
        switch(f){
                case 'B':
                        val.b = (jbyte)va_arg(*list, int) ;
                        ret = create_primitive_object(env, f, "java/lang/Byte", val) ;
                        break ;
                case 'S':
                        val.s = (jshort)va_arg(*list, int) ;
                        ret = create_primitive_object(env, f, "java/lang/Short", val) ;
                        break ;
                case 'I':
                        val.i = (jint)va_arg(*list, int) ;
                        ret = create_primitive_object(env, f, "java/lang/Integer", val) ;
                        break ;
                case 'J':
                        val.d = (jdouble)va_arg(*list, double) ;
                        ret = create_primitive_object(env, f, "java/lang/Long", val) ;
                        break ;
                case 'F':
                        /* Seems float is not properly promoted to double... */
                        val.i = (jint)va_arg(*list, int) ;
                        ret = create_primitive_object(env, f, "java/lang/Float", val) ;
                        break ;
                case 'D':
                        val.d = (jdouble)va_arg(*list, double) ;
                        ret = create_primitive_object(env, f, "java/lang/Double", val) ;
                        break ;
                case 'Z':
                        val.z = (jboolean)va_arg(*list, int) ;
                        ret = create_primitive_object(env, f, "java/lang/Boolean", val) ;
                        break ;
                case 'C':
                        val.c = (jchar)va_arg(*list, int) ;
                        ret = create_primitive_object(env, f, "java/lang/Character", val) ;
                        break ;
        }
        return ret ;
}
/*
        This is the generic native function that callback java to call the proper
        perl method.
*/
jobject JNICALL generic_perl_native(JNIEnv *env, jobject obj, ...){
        va_list list ;
        jclass cls ;
        jmethodID mid ;
        jstring jfmt ;
        char *fmt ;
        int fmt_len ;
        jclass obj_cls ;
        jobjectArray obj_array ;
        jobject arg ;
        int i ;
        jobject ret = NULL ;
        cls = (*(env))->GetObjectClass(env, obj) ;
        mid = (*(env))->GetMethodID(env, cls, "LookupMethod", "()Ljava/lang/String;") ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        /* Call obj.LookupMethod to get the format string */
        jfmt = (*(env))->CallObjectMethod(env, obj, mid) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        fmt = (char *)((*(env))->GetStringUTFChars(env, jfmt, NULL)) ;
        fmt_len = strlen(fmt) ;
        obj_cls = (*(env))->FindClass(env, "java/lang/Object") ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        obj_array = (*(env))->NewObjectArray(env, fmt_len, obj_cls, NULL) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        (*(env))->SetObjectArrayElement(env, obj_array, 0, obj) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        va_start(list, obj) ;
        for (i = 1 ; i < fmt_len ; i++){
                if (fmt[i] != 'L'){
                        arg = extract_va_arg(env, &list, fmt[i]) ;
                        if (arg == NULL){
                                return NULL ;
                        }
                }
                else{
                        arg = (jobject)va_arg(list, jobject) ;
                }
                (*(env))->SetObjectArrayElement(env, obj_array, i, arg) ;
                if (check_exception_from_java(env)){
                        return NULL ;
                }
        }
        va_end(list) ;
        /* Call obj.InvokePerlMethod and grab the returned object and return it */
        mid = (*(env))->GetMethodID(env, cls, "InvokePerlMethod", "([Ljava/lang/Object;)Ljava/lang/Object;") ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        ret = (*(env))->CallObjectMethod(env, obj, mid, obj_array) ;
        if (check_exception_from_java(env)){
                return NULL ;
        }
        return ret ;
}
/*
        This function is used to register the specified native method and associate it with our magic
        method that trap and redirects all the Perl native calls.
*/
JNIEXPORT void JNICALL Java_org_perl_inline_java_InlineJavaPerlNatives_RegisterMethod(JNIEnv *env, jobject obj, jclass cls, jstring name, jstring signature){
        JNINativeMethod nm ;
        /* Register the function */
        nm.name = (char *)((*(env))->GetStringUTFChars(env, name, NULL)) ;
        nm.signature = (char *)((*(env))->GetStringUTFChars(env, signature, NULL)) ;
        nm.fnPtr = generic_perl_native ;
        (*(env))->RegisterNatives(env, cls, &nm, 1) ;
        (*(env))->ReleaseStringUTFChars(env, name, nm.name) ;
        (*(env))->ReleaseStringUTFChars(env, signature, nm.signature) ;
        if (check_exception_from_java(env)){
                return ;
        }
}