//
//  PerlMethods.m
//  CamelBones
//
//  Copyright (c) 2004 Sherm Pendley. All rights reserved.
//

#import <Foundation/Foundation.h>
#import "CBPerl.h"
#import "CBPerlObject.h"
#import "Conversions.h"
#import "PerlImports.h"

// Get information about a Perl object
NSString* CBGetMethodNameForSelector(SV* sv, SEL selector) {
    // Define a Perl context
    dTHX;

    HV* hash = (HV*)SvRV(sv);
    HV* stash = SvSTASH(hash);
    char *package = HvNAME(stash);
    NSMutableString *ms = [NSMutableString stringWithString: NSStringFromSelector(selector)];

    NSString *methodEntryName = [NSString stringWithFormat: @"$%s::OBJC_EXPORT{'%@'}->{'method'}", package, ms];
    id methodEntry = [[CBPerl sharedPerl] eval: methodEntryName];

    NSRange all;

    if (methodEntry != nil) {
        return methodEntry;
    }
    
    all = [ms rangeOfString: @":"];
    while (all.length != 0) {
        [ms replaceCharactersInRange: all withString: @"_"];
        all = [ms rangeOfString: @":"];
    }
    if ([ms hasSuffix: @"_"]) {
        all = NSMakeRange([ms length]-1, 1);
        [ms deleteCharactersInRange: all];
    }

    if (gv_fetchmethod(stash, [ms UTF8String]) != NULL) {
        return ms;
    } else {
        return nil;
    }
    return nil;
}

NSString* CBGetMethodArgumentSignatureForSelector(SV* sv, SEL selector) {
    // Define a Perl context
    dTHX;

    HV* hash = (HV*)SvRV(sv);
    HV* stash = SvSTASH(hash);
    char *package = HvNAME(stash);
    NSMutableString *ms = [NSMutableString stringWithString: NSStringFromSelector(selector)];
    NSMutableString *params = [NSMutableString stringWithString: @""];

    NSString *methodEntryName = [NSString stringWithFormat: @"$%s::OBJC_EXPORT{'%@'}->{'args'}", package, ms];
    id methodEntry = [[CBPerl sharedPerl] eval: methodEntryName];

    NSRange all;

    if (methodEntry != nil) {
        return methodEntry;
    }

    all = [ms rangeOfString: @":"];
    while (all.length != 0) {
        [params appendString: @"@"];
        [ms replaceCharactersInRange: all withString: @"_"];
        all = [ms rangeOfString: @":"];
    }

    if ([ms hasSuffix: @"_"]) {
        all = NSMakeRange([ms length]-1, 1);
        [ms deleteCharactersInRange: all];
    }

    if (gv_fetchmethod(stash, [ms UTF8String]) != NULL) {
        return params;
    } else {
        return @"";
    }
    return @"";
}

NSString* CBGetMethodReturnSignatureForSelector(SV* sv, SEL selector) {
    // Define a Perl context
    dTHX;

    HV* hash = (HV*)SvRV(sv);
    HV* stash = SvSTASH(hash);
    char *package = HvNAME(stash);
    NSMutableString *ms = [NSMutableString stringWithString: NSStringFromSelector(selector)];

    NSString *methodEntryName = [NSString stringWithFormat: @"$%s::OBJC_EXPORT{'%@'}->{'return'}", package, ms];
    id methodEntry = [[CBPerl sharedPerl] eval: methodEntryName];

    NSRange all;

    if (methodEntry != nil) {
        return methodEntry;
    }

    all = [ms rangeOfString: @":"];
    while (all.length != 0) {
        [ms replaceCharactersInRange: all withString: @"_"];
        all = [ms rangeOfString: @":"];
    }

    if ([ms hasSuffix: @"_"]) {
        all = NSMakeRange([ms length]-1, 1);
        [ms deleteCharactersInRange: all];
    }

    if (gv_fetchmethod(stash, [ms UTF8String]) != NULL) {
        if ([ms hasPrefix: @"get"]) {
            return @"@";
        } else {
            return @"@";
        }
    } else {
        return @"@";
    }
    return @"@";
}

void CBForwardObjectInvocationToObject(id self, NSInvocation *anInvocation, SV *sv) {
    // Define a Perl context
    dTHX;

    dSP;
    int count;

    HV *methodSignaturesHash;

    HE *methodSigEntry;
    SV *methodSigRef;
    HV *methodSigHash;

    HE *methodNameEntry;
    SV *methodNameEntryVal;

    HV *methodStash;

    char *tempMethodName;
    const char *methodName;
    const char *selUTF8String;
    SV *selString;

    NSMethodSignature *methodSignature;
    int numArgs;
    const char *returnType;
    void *buf;
    void *returnValue;
    char *stringBuf;
    char *returnBuf;
    NSMutableArray *returnList;
    id idBuf;
    NSString *className;
    const char *classNameUTF8String;

    BOOL listContext;

    STRLEN n_a;

    n_a = 0;

    // Get this class name
    className = [self perlClassName];
    
    // Get this method signature
    methodSignature = [anInvocation methodSignature];

    buf = malloc([methodSignature frameLength]);
    if (!buf) return;

    selUTF8String = [NSStringFromSelector([anInvocation selector]) UTF8String];

    // Get a string for the selector
    selString = newSVpv(selUTF8String, 0);
    if (!selString)
        return;

    do {
        tempMethodName = NULL;
        listContext = FALSE;

        // Make certain sv is a valid object reference
        if (!(sv && sv_isobject(sv)))
            break;
    
        // Try to get %OBJC_METHOD_SIGNATURES out of the appropriate package
        classNameUTF8String = [[NSString stringWithFormat: @"%@::OBJC_METHOD_SIGNATURES", className] UTF8String];
        methodSignaturesHash = get_hv(classNameUTF8String, NO);
        if (!methodSignaturesHash)
            break;
    
        // Get a reference to the hash for this signature
        methodSigEntry = hv_fetch_ent(methodSignaturesHash, selString, 0, 0);
        if (!methodSigEntry)
            break;
    
        // Verify the reference
        methodSigRef = HeVAL(methodSigEntry);
        if (!methodSigRef)
            break;
        if (!SvROK(methodSigRef))
            break;
    
        // Deref the reference to get the hash table for this method
        methodSigHash = (HV *)SvRV(methodSigRef);
        if (!methodSigHash)
            break;

        // If there exists an 'listContext' entry, flag it as such
        if (hv_exists_ent(methodSigHash, sv_2mortal(newSVpv("listContext", 0)), 0))
            listContext = TRUE;
        else
            listContext = FALSE;
    
        // Get the methodNameEntry entry
        methodNameEntry = hv_fetch_ent(methodSigHash, sv_2mortal(newSVpv("perlMethod", 0)), 0, 0);
        if (!methodNameEntry)
            break;
    
        // Get the value of the args entry
        methodNameEntryVal = HeVAL(methodNameEntry);
        if (!methodNameEntryVal)
            break;
    
        // Finally! Make it a C string
        tempMethodName = SvPV_nolen(methodNameEntryVal);

    } while (0);

    // If the method name is undefined just use the selector name
    if (tempMethodName == NULL || strlen(tempMethodName) == 0)
        methodName = selUTF8String;
    else
        methodName = tempMethodName;

    // Now verify that the method is defined

    // First get the namespace stash for this object
    methodStash = SvSTASH(SvRV((SV *)sv));
    if (!methodStash)
        return;

    // Get the entry for this method name
    methodName = [CBGetMethodNameForSelector(sv, [anInvocation selector]) UTF8String];

    if (!methodName) {
        const char *rt = [methodSignature methodReturnType];
        const char *at = [methodSignature getArgumentTypeAtIndex: 2];

        NSMutableString *methodNameString = [NSStringFromSelector([anInvocation selector]) mutableCopy];

        // May be a candidate for auto-setName: magic
        if ( [methodNameString hasPrefix: @"set"] &&
             [methodSignature numberOfArguments] == 3 &&
             (*rt) == 'v' ) {

            NSRange propNameRange = NSMakeRange(3, [methodNameString length] - 4);
            NSMutableString *ms = [NSMutableString stringWithString: [methodNameString substringWithRange: propNameRange]];

            if ([self hasProperty: ms]) {
                // Do set[Name]: magic
                switch (*at) {
                    case '@':
                        [anInvocation getArgument: &idBuf atIndex: 2];
                        [self setProperty: ms toObject: idBuf];
                    default:
                        break;
                }
                return;
            }

        } else if ([self hasProperty: methodNameString] &&
                   [methodSignature numberOfArguments] == 2 &&
                   (*rt) == '@' ) {
            idBuf = [self getProperty: methodNameString];
            [anInvocation setReturnValue: &idBuf];
            return;

        } else {
            NSLog(@"Property %@ is not defined in Perl class %@", methodNameString, className);
            return;
        }
    }

    ENTER;
    SAVETMPS;
    
    PUSHMARK(SP);

    // Push "self" onto the stack first
    XPUSHs(sv);

    // If there are arguments, push them onto the call stack
    numArgs = [methodSignature numberOfArguments];

    if (numArgs > 2 && buf != NULL) {
        int i;
        for(i = 2; i < numArgs; i++) {
            const char *argType;

            argType = [methodSignature getArgumentTypeAtIndex: i];
            switch (*argType) {
                case 'c':
                    // char
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(char *)buf)));
                    break;

                case 'i':
                    // int
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(int *)buf)));
                    break;

                case 's':
                    // short
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(short *)buf)));
                    break;

                case 'l':
                    // long
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(long *)buf)));
                    break;

                case 'q':
                    // long long
                    NSLog(@"Unknown type long long in position %d", argType, i);

                case 'C':
                    // unsigned char
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(unsigned char *)buf)));
                    break;
                    
                case 'I':
                    // unsigned int
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(unsigned int *)buf)));
                    break;
                    
                case 'S':
                    // unsigned short
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(unsigned short *)buf)));
                    break;
                    
                case 'L':
                    // unsigned long
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(unsigned long *)buf)));
                    break;
                    
                case 'Q':
                    // unsigned long long
                    NSLog(@"Unknown type unsigned long long in position %d", argType, i);

                case 'f':
                    // float
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSVnv(*(float *)buf)));
                    break;
                    
                case 'd':
                    // double
                    [anInvocation getArgument: buf atIndex: i];
                    XPUSHs(sv_2mortal(newSViv(*(double *)buf)));
                    break;
                    
                case 'v':
                    // void
                    break;

                case '*':
                    // char *
                    [anInvocation getArgument: &stringBuf atIndex: i];
                    XPUSHs(sv_2mortal(newSVpv(stringBuf, 0)));
                    break;
                    
                case '@':
                    // id
                    [anInvocation getArgument: &idBuf atIndex: i];
                    XPUSHs(CBDerefIDtoSV(idBuf));
                    break;
                    
                case '^':
                	XPUSHs(sv_2mortal(newSViv(*(int*)buf)));
                	break;

                case '#':
                    // Class

                case ':':
                    // SEL

                case '[':
                    // array

                case '{':
                    // struct

                case '(':
                    // union

                case 'b':
                    // bit field

                case '?':
                    // unknown

                default:
                    NSLog(@"Unknown type %s in position %d", argType, i);
            }
        }
    }

    PUTBACK;

    // Call the method in an "eval" block so errors can be trapped
    if (listContext)
        count = call_method(methodName, G_EVAL | G_ARRAY);
    else
        count = call_method(methodName, G_EVAL | G_SCALAR);

    SPAGAIN;

    // Check for an error
    if (SvTRUE(ERRSV)) {
        NSLog(@"Perl error: %s", SvPV(ERRSV, n_a));
    }

    // No error
    returnType = [methodSignature methodReturnType];
    returnValue = NULL;
    returnBuf = NULL;
    idBuf = nil;
    if (count) {
        switch (*returnType) {
            case 'c':
                // char
                *(char *)buf = (char)POPi;
                returnValue = buf;
                break;
    
            case 'i':
                // int
                *(int *)buf = (int)POPi;
                returnValue = buf;
                break;
    
            case 's':
                // short
                *(short *)buf = (short)POPi;
                returnValue = buf;
                break;
    
            case 'l':
                // long
                *(long *)buf = (long)POPi;
                returnValue = buf;
                break;
    
            case 'q':
                // long long
                NSLog(@"Long long return value not implemented");
                break;
    
            case 'C':
                // unsigned char
                *(unsigned char *)buf = (unsigned char)POPi;
                returnValue = buf;
                break;
    
            case 'I':
                // unsigned int
                *(unsigned int *)buf = (unsigned int)POPi;
                returnValue = buf;
                break;
                
            case 'S':
                // unsigned short
                *(unsigned short *)buf = (unsigned short)POPi;
                returnValue = buf;
                break;
                
            case 'L':
                // unsigned long
                *(unsigned long *)buf = (unsigned long)POPi;
                returnValue = buf;
                break;
                
            case 'Q':
                // unsigned long long
                NSLog(@"Unsigned long long return value not implemented");
                break;
    
            case 'f':
                // float
                *(float *)buf = (float)POPn;
                returnValue = buf;
                break;
                
            case 'd':
                // double
                *(double *)buf = (double)POPn;
                returnValue = buf;
                break;
                
            case 'v':
                // void
                returnValue = &returnBuf;
                break;
    
            case '*':
                // char *
                returnBuf = (void *) newSVpv(POPp, 0);
                stringBuf = SvPV((SV *) returnBuf, n_a);
                returnValue = &stringBuf;
                break;
    
            case '@':
                // id

                // id supports list context
                if (listContext) {
                    returnList = [NSMutableArray arrayWithCapacity: count];
                    returnValue = &returnList;
                }

                while (count) {
                    idBuf = CBDerefSVtoID(POPs);
        
                    if (listContext)
                        [returnList insertObject: idBuf atIndex: count];
                    else
                        returnValue = &idBuf;

                    count--;
                }

                break;

            case '^':
                // pointer
                *(int *)buf = (int)POPi;
                returnValue = buf;
                break;
    
            case '#':
                // Class
                returnValue = &returnBuf;
                break;
    
            case ':':
                // SEL
                returnValue = &returnBuf;
                break;
    
            case '[':
                // array
                returnValue = &returnBuf;
                break;
    
            case '{':
                // struct
                returnValue = &returnBuf;
                break;
    
            case '(':
                // union
                returnValue = &returnBuf;
                break;
    
            case 'b':
                // bit field
                returnValue = &returnBuf;
                break;
    
            case '?':
                // unknown
                returnValue = &returnBuf;
                break;
    
            default:
                NSLog(@"Unknown return type %s", returnType);
                returnValue = &returnBuf;
                break;
        }
    } else {
        returnValue = &returnBuf;
    }
    
    FREETMPS;
    LEAVE;

    if (*returnType != 'v') {
        [anInvocation setReturnValue: returnValue];
    }

    free(buf);

    if (returnBuf)
        SvREFCNT_dec((SV *) returnBuf);
}