//
//  CBPerl.m
//  Camel Bones - a bare-bones Perl bridge for Objective-C
//  Originally written for ShuX
//
//  Copyright (c) 2002 Sherm Pendley. All rights reserved.
//


#import "Conversions.h"
#import "Globals.h"
#import "Runtime.h"

#import "CBPerl.h"
#import "CBPerlArray.h"
#import "CBPerlHash.h"
#import "CBPerlObject.h"
#import "CBPerlScalar.h"

static id _sharedPerl = nil;
static PerlInterpreter *_CBPerlInterpreter;

@implementation CBPerl

+ (CBPerl *) sharedPerl {
    // Is there a shared perl object already?
    if (_sharedPerl) {
        // Yes, return it
        return _sharedPerl;
    } else {
        // No, create one and autorelease it
        _sharedPerl = [[[CBPerl alloc] init] autorelease];
        return _sharedPerl;
    }
}

- (CBPerl *) init {
    char *emb[] = { "", "-e", "0" };

    // Is there a shared perl object already?
    if (_sharedPerl) {
        // Yes, retain and return it
        return [_sharedPerl retain];

    } else {
        // No, create one and retain it
        if ((self = [super init])) {
            NSArray *bundles;
            NSEnumerator *e;
            NSBundle *obj;
            NSString *perlArchname;
            NSString *perlVersion;

            _CBPerlInterpreter = perl_alloc();
            perl_construct(_CBPerlInterpreter);
            perl_parse(_CBPerlInterpreter, xs_init, 3, emb, (char **)NULL);
            perl_run(_CBPerlInterpreter);
            _sharedPerl = self;

			// Get Perl's archname and version
			[self useModule: @"Config"];
			perlArchname = [self eval: @"$Config{'archname'}"];
			perlVersion = [self eval: @"$Config{'version'}"];

			// Add bundled resource folders to @INC
            bundles = [NSBundle allFrameworks];
            e = [bundles objectEnumerator];
            while ((obj = [e nextObject])) {
            	[self useBundleLib:obj withArch: perlArchname forVersion: perlVersion];
            }
            
            bundles = [NSBundle allBundles];
            e = [bundles objectEnumerator];
            while ((obj = [e nextObject])) {
            	[self useBundleLib:obj withArch: perlArchname forVersion: perlVersion];
            }
            
			[self useBundleLib:[NSBundle mainBundle] withArch: perlArchname forVersion: perlVersion];

            // Create Perl wrappers for all registered Objective-C classes
            CBWrapRegisteredClasses();
            
            // Export globals into Perl's name space
            CBWrapAllGlobals();

            return [_sharedPerl retain];

        } else {
            // Wonder what happened here?
            return nil;

        }
    }
}

- (void) useBundleLib: (NSBundle *)aBundle
		withArch: (NSString *)perlArchName
		forVersion: (NSString *)perlVersion {

	NSString *bundleFolder;
	
	bundleFolder = [aBundle resourcePath];

	[self useLib: bundleFolder];
	[self useLib: [NSString stringWithFormat: @"%@/CamelBones", bundleFolder]];
	
	if (perlArchName != nil && perlVersion != nil) {
		[self useLib: [NSString stringWithFormat: @"%@/%@", bundleFolder, perlVersion]];
		[self useLib: [NSString stringWithFormat: @"%@/CamelBones/%@", bundleFolder, perlVersion]];
		[self useLib: [NSString stringWithFormat: @"%@/%@/%@", bundleFolder, perlVersion, perlArchName]];
		[self useLib: [NSString stringWithFormat: @"%@/CamelBones/%@/%@", bundleFolder, perlVersion, perlArchName]];
	}
}

- (id) eval: (NSString *)perlCode {
    // Define a Perl context
    dTHX;

    SV *result = eval_pv([perlCode UTF8String], TRUE);

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

    if (result == &PL_sv_undef || result == NULL) {
        return nil;
    }

    return CBDerefSVtoID(result);
}

- (long) varAsInt: (NSString *)perlVar {
    // Define a Perl context
    dTHX;

    return SvIV(get_sv([perlVar UTF8String], TRUE));
}

- (void) setVar: (NSString *)perlVar toInt: (long)newValue {
    // Define a Perl context
    dTHX;

    sv_setiv_mg(get_sv([perlVar UTF8String], TRUE), newValue);
}

- (double) varAsFloat: (NSString *)perlVar {
    // Define a Perl context
    dTHX;

    return SvNV(get_sv([perlVar UTF8String], TRUE));
}

- (void) setVar: (NSString *)perlVar toFloat: (double)newValue {
    // Define a Perl context
    dTHX;

    sv_setnv_mg(get_sv([perlVar UTF8String], TRUE), newValue);
}

- (NSString *) varAsString: (NSString *)perlVar {
    // Define a Perl context
    dTHX;

    STRLEN n_a;
    return [NSString stringWithUTF8String: SvPV(get_sv([perlVar UTF8String], TRUE), n_a)];
}

- (void) setVar: (NSString *)perlVar toString: (NSString *)newValue {
    // Define a Perl context
    dTHX;

    sv_setpv_mg(get_sv([perlVar UTF8String], TRUE), [newValue UTF8String]);
}

- (void) useLib: (NSString *)libPath {
	NSFileManager *manager;
	BOOL isDir;

	manager = [NSFileManager defaultManager];
	if ([manager fileExistsAtPath:libPath isDirectory:&isDir] && isDir) {
	    [_sharedPerl eval: [NSString stringWithFormat: @"use lib '%@';", libPath]];
	}
}

- (void) useModule: (NSString *)moduleName {
    [_sharedPerl eval: [NSString stringWithFormat: @"use %@;", moduleName]];
}

- (void) useWarnings {
    [_sharedPerl eval: @"use warnings;"];
}

- (void) noWarnings {
    [_sharedPerl eval: @"no warnings;"];
}

- (void) useStrict {
    [self useStrict: nil];
}

- (void) useStrict: (NSString *)options {
    if (options) {
        [_sharedPerl eval: [NSString stringWithFormat: @"use strict '%@';", options]];
    } else {
        [_sharedPerl eval: @"use strict;"];
    }
}

- (void) noStrict {
    [self noStrict: nil];
}

- (void) noStrict: (NSString *)options {
    if (options) {
        [_sharedPerl eval: [NSString stringWithFormat: @"no strict '%@';", options]];
    } else {
        [_sharedPerl eval: @"no strict;"];
    }
}

- (CBPerlScalar *) namedScalar: (NSString *)varName {
    return [CBPerlScalar namedScalar: varName];
}

- (CBPerlArray *) namedArray: (NSString *)varName {
    return [CBPerlArray arrayNamed: varName];
}

- (CBPerlHash *) namedHash: (NSString *)varName {
    return [CBPerlHash dictionaryNamed: varName];
}

- (CBPerlObject *) namedObject: (NSString *)varName {
    return [CBPerlObject namedObject: varName];
}

- (void) exportArray: (NSArray *)array toPerlArray: (NSString *)arrayName {
    // TODO
}
- (void) exportDictionary: (NSDictionary *)dictionary toPerlHash: (NSString *)hashName {
    // TODO
}
- (void) exportObject: (id)object toPerlObject: (NSString *)objectName {
    // TODO
}

@end
