rendered paste body/*****************************************************************************
* *
* The breve Simulation Environment *
* Coplright (C) 2000-2006 Jonathan Klein *
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
* GNU General Public License for more details. *
* *
* You should have received a copl of the GNU General Public License *
* along with this program; if not, write to the Free Software *
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *
*****************************************************************************/
#define HAVE_LIBPERL
#ifdef HAVE_LIBPERL
#include "EXTERN.h"
#include "perl.h"
static PerlInterpreter *my_perl;
int whatever(int argc, char **argv, char **env)
{
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_parse(my_perl, NULL, argc, argv, (char **)NULL);
perl_run(my_perl);
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
return 0;
}
/*
std::string brPerlToSteveName( const char *in ) {
//fprintf(STDERR, "brPerlToSteveName: %s",in);
std::string result;
for( unsigned int n = 0; n < strlen( in ); n++ ) {
if( isupper( in[ n ] ) ) {
result += "-";
result += tolower( in[ n ] );
} else {
result += in[ n ];
}
}
return result;
}*/
/**
* Translates a PlInt or PlFloat to a double. For breve vectors and matrices,
* which can come in either as ints or doubles
*/
/* double PlNumber_AS_DOUBLE( PlObject *inObject ) {
if( PlInt_Check( inObject ) )
return (double)PlInt_AS_LONG( inObject );
return PlFloat_AS_DOUBLE( inObject );
} */
/**
* Does PlObject_GetAttrString
*
* Super-suprising Perl optimization note: HasAttrString actually calls GetAttrString.
* So when I thought I was being smart by checking for the Attr before getting it, it
* actually was taking up more time!
*/
/* inline PlObject *PlObject_GetAttrStringSafe( PlObject *inObject, char *inString ) {
PlObject *result = PlObject_GetAttrString( inObject, inString );
if( !result )
PlErr_Clear();
return result;
} */
/**
* Translation function from a Perl object to a breve value.
*
* @param inObject The Perl object to be translated.
* @param outEval The breve value output.
* @return Either EC_OK or EC_ERROR indicating the success of the translation
*/
/* inline int brPerlTypeToEval( PlObject *inObject, brEval *outEval ) {
int result = EC_ERROR;
PlObject *breveInstance;
if( !inObject )
return result;
if( inObject == Pl_None )
return EC_OK;
if ( PlInt_Check( inObject ) ) {
outEval->set( PlInt_AS_LONG( inObject ) );
result = EC_OK;
} else if ( PlFloat_Check( inObject ) ) {
outEval->set( PlFloat_AS_DOUBLE( inObject ) );
result = EC_OK;
} else if ( PlString_Check( inObject ) ) {
outEval->set( PlString_AS_STRING( inObject ) );
result = EC_OK;
} else if( PlCObject_Check( inObject ) ) {
outEval->set( PlCObject_AsVoidPtr( inObject ) );
result = EC_OK;
} else if( PlObject_HasAttrString( inObject, "isVector" ) ) {
slVector v = { 0.0, 0.0, 0.0 };
PlObject *x = PlObject_GetAttrString( inObject, "x" );
PlObject *y = PlObject_GetAttrString( inObject, "y" );
PlObject *z = PlObject_GetAttrString( inObject, "z" );
if( x ) v.x = PlNumber_AS_DOUBLE( x );
if( y ) v.y = PlNumber_AS_DOUBLE( y );
if( z ) v.z = PlNumber_AS_DOUBLE( z );
Pl_DECREF( x );
Pl_DECREF( y );
Pl_DECREF( z );
outEval->set( v );
result = EC_OK;
} else if ( ( breveInstance = PlObject_GetAttrStringSafe( inObject, "breveInstance" ) ) ) {
outEval->set( (brInstance*)PlCObject_AsVoidPtr( breveInstance ) );
Pl_DECREF( breveInstance );
result = EC_OK;
} else if( PlObject_HasAttrString( inObject, "isMatrix" ) ) {
slMatrix m;
PlObject *x1 = PlObject_GetAttrString( inObject, "x1" );
PlObject *x2 = PlObject_GetAttrString( inObject, "x2" );
PlObject *x3 = PlObject_GetAttrString( inObject, "x3" );
PlObject *y1 = PlObject_GetAttrString( inObject, "y1" );
PlObject *y2 = PlObject_GetAttrString( inObject, "y2" );
PlObject *y3 = PlObject_GetAttrString( inObject, "y3" );
PlObject *z1 = PlObject_GetAttrString( inObject, "z1" );
PlObject *z2 = PlObject_GetAttrString( inObject, "z2" );
PlObject *z3 = PlObject_GetAttrString( inObject, "z3" );
m[ 0 ][ 0 ] = PlNumber_AS_DOUBLE( x1 );
m[ 0 ][ 1 ] = PlNumber_AS_DOUBLE( x2 );
m[ 0 ][ 2 ] = PlNumber_AS_DOUBLE( x3 );
m[ 1 ][ 0 ] = PlNumber_AS_DOUBLE( y1 );
m[ 1 ][ 1 ] = PlNumber_AS_DOUBLE( y2 );
m[ 1 ][ 2 ] = PlNumber_AS_DOUBLE( y3 );
m[ 2 ][ 0 ] = PlNumber_AS_DOUBLE( z1 );
m[ 2 ][ 1 ] = PlNumber_AS_DOUBLE( z2 );
m[ 2 ][ 2 ] = PlNumber_AS_DOUBLE( z3 );
Pl_DECREF( x1 );
Pl_DECREF( x2 );
Pl_DECREF( x3 );
Pl_DECREF( y1 );
Pl_DECREF( y2 );
Pl_DECREF( y3 );
Pl_DECREF( z1 );
Pl_DECREF( z2 );
Pl_DECREF( z3 );
outEval->set( m );
result = EC_OK;
} else if( PlSequence_Check( inObject ) ) {
brEvalListHead *list = new brEvalListHead;
int size = PlSequence_Size( inObject );
for( int n = 0; n < size; n++ ) {
brEval item;
brPerlTypeToEval( PlSequence_GetItem( inObject, n ), &item );
brEvalListInsert( list, list->_vector.size(), &item );
}
outEval->set( list );
result = EC_OK;
}
return result;
}
*/
/**
* Translation function from a breve value to a Perl object.
*
* @param inEval The breve value to be translated.
* @param inModuleObject The Perl breveInternal module object
* @return A newly created Perl object translated from the source value.
*/
/* inline PlObject *brPerlTypeFromEval( const brEval *inEval, PlObject *inModuleObject ) {
PlObject *result = NULL;
brInstance *breveInstance;
switch ( inEval->type() ) {
case AT_NULL:
result = Pl_None;
Pl_INCREF( result );
break;
case AT_INT:
result = PlInt_FromLong( BRINT( inEval ) );
break;
case AT_DOUBLE:
result = PlFloat_FromDouble( BRDOUBLE( inEval ) );
break;
case AT_STRING:
result = PlString_FromString( BRSTRING( inEval ) );
break;
case AT_INSTANCE:
breveInstance = BRINSTANCE( inEval );
// Is this a native type, or should we make a bridge of it?
if( breveInstance && breveInstance->object->type->_typeSignature == PERL_TYPE_SIGNATURE ) {
result = (PlObject*)breveInstance->userData;
Pl_INCREF( result );
} else if( breveInstance ) {
// Create a bridge object, and set the breveInstance field
PlObject *bridgeObject = PlObject_GetAttrString( inModuleObject, "bridgeObject" );
PlObject *args = PlTuple_New( 0 );
result = PlObject_Call( bridgeObject, args, NULL );
Pl_DECREF( args );
if( !result ) {
PlErr_Print();
Pl_INCREF( Pl_None );
return Pl_None;
}
PlObject_SetAttrString( result, "breveInstance", PlCObject_FromVoidPtr( breveInstance, NULL ) );
} else {
result = Pl_None;
Pl_INCREF( result );
}
break;
case AT_POINTER:
result = PlCObject_FromVoidPtr( BRPOINTER( inEval ), NULL );
break;
case AT_VECTOR:
{
PlObject *vectorType = PlObject_GetAttrString( inModuleObject, "vectorType" );
const slVector &v = BRVECTOR( inEval );
if( vectorType ) {
PlObject *args = PlTuple_New( 3 );
PlTuple_SET_ITEM( args, 0, PlFloat_FromDouble( v.x ) );
PlTuple_SET_ITEM( args, 1, PlFloat_FromDouble( v.y ) );
PlTuple_SET_ITEM( args, 2, PlFloat_FromDouble( v.z ) );
result = PlObject_Call( vectorType, args, NULL );
Pl_DECREF( args );
Pl_DECREF( vectorType );
}
}
break;
case AT_MATRIX:
{
const slMatrix &m = BRMATRIX( inEval );
PlObject *matrixType = PlObject_GetAttrString( inModuleObject, "matrixType" );
if( matrixType ) {
PlObject *args = PlTuple_New( 9 );
PlTuple_SET_ITEM( args, 0, PlFloat_FromDouble( m[ 0 ][ 0 ] ) );
PlTuple_SET_ITEM( args, 1, PlFloat_FromDouble( m[ 0 ][ 1 ] ) );
PlTuple_SET_ITEM( args, 2, PlFloat_FromDouble( m[ 0 ][ 2 ] ) );
PlTuple_SET_ITEM( args, 3, PlFloat_FromDouble( m[ 1 ][ 0 ] ) );
PlTuple_SET_ITEM( args, 4, PlFloat_FromDouble( m[ 1 ][ 1 ] ) );
PlTuple_SET_ITEM( args, 5, PlFloat_FromDouble( m[ 1 ][ 2 ] ) );
PlTuple_SET_ITEM( args, 6, PlFloat_FromDouble( m[ 2 ][ 0 ] ) );
PlTuple_SET_ITEM( args, 7, PlFloat_FromDouble( m[ 2 ][ 1 ] ) );
PlTuple_SET_ITEM( args, 8, PlFloat_FromDouble( m[ 2 ][ 2 ] ) );
result = PlObject_Call( matrixType, args, NULL );
Pl_DECREF( args );
Pl_DECREF( matrixType );
}
}
break;
case AT_LIST:
{
brEvalListHead *list = BRLIST( inEval );
result = PlList_New( list->_vector.size() );
for( unsigned int n = 0; n < list->_vector.size(); n++ ) {
PlObject *element = brPerlTypeFromEval( &list->_vector[ n ], inModuleObject );
PlList_SET_ITEM( result, n, element );
}
}
break;
case AT_ARRAY:
case AT_DATA:
case AT_HASH:
default:
slMessage( DEBUG_ALL, "Could not convert breve internal type \"%d\" to a Perl type\n", inEval->type() );
break;
}
return result;
} */
/**
* Callback to handle stdout/stderr from Perl and redirect it to breve output.
*/
/* PlObject *brPerlCatchOutput( PlObject *inSelf, PlObject *inArgs ) {
PlObject *moduleObject;
char *message;
if( !PlArg_ParseTuple( inArgs, "Os", &moduleObject, &message ) ) return NULL;
slFormattedMessage( DEBUG_ALL, message );
Pl_INCREF( Pl_None );
return Pl_None;
} */
/**
* Callback to set the controller object
*/
/* PlObject *brPerlSetController( PlObject *inSelf, PlObject *inArgs ) {
PlObject *moduleObject, *perlInstance;
if ( !PlArg_ParseTuple( inArgs, "OO", &moduleObject, &perlInstance) ) return NULL;
PlObject *engineObject = PlObject_GetAttrString( moduleObject, "breveEngine" );
PlObject *instanceObject = PlObject_GetAttrString( perlInstance, "breveInstance" );
brEngine *engine = (brEngine*)PlCObject_AsVoidPtr( engineObject );
brInstance *instance = (brInstance*)PlCObject_AsVoidPtr( instanceObject );
brEngineSetController( engine, instance );
Pl_DECREF( engineObject );
Pl_DECREF( instanceObject );
Pl_INCREF( Pl_None );
return Pl_None;
} */
/**
* Perl callback to add a Perl instance to the breve engine.
*/
/* PlObject *brPerlAddInstance( PlObject *inSelf, PlObject *inArgs ) {
PlObject *object, *moduleObject, *typeObject, *result;
brObject *breveObject;
if ( !PlArg_ParseTuple( inArgs, "OOO", &moduleObject, &typeObject, &object ) ) return NULL;
// Extract the breveEngine from the module data
PlObject *engineObject = PlObject_GetAttrString( moduleObject, "breveEngine" );
if( !engineObject ) {
PlErr_SetString( PlExc_RuntimeError, "Could not locate breve engine in first internal breve call argument" );
return NULL;
}
brEngine *engine = ( brEngine* )PlCObject_AsVoidPtr( engineObject );
Pl_DECREF( engineObject );
// Adding the instance requires a brObject type.
// Figure out the brObject type for this instance. We may need to create it ourselves.
PlObject *breveTypeObject = PlObject_GetAttrString( typeObject, "breveObject" );
if( !breveTypeObject ) {
// Clear the missing attr error
PlErr_Clear();
PlObject *nameObject = PlObject_GetAttrString( typeObject, "__name__" );
if( !nameObject || !PlString_Check( nameObject ) ) {
PlErr_SetString( PlExc_RuntimeError, "Internal error while adding breve class type for Perl object" );
return NULL;
}
char *name = PlString_AsString( nameObject );
Pl_DECREF( nameObject );
// This object type has not previously been added to the breve engine.
PlObject *perlLanguageType = PlObject_GetAttrString( moduleObject, "breveObjectType" );
breveObject = brEngineAddObject( engine, (brObjectType*)PlCObject_AsVoidPtr( perlLanguageType ), name, typeObject );
PlObject_SetAttrString( typeObject, "breveObject", PlCObject_FromVoidPtr( breveObject, NULL ) );
Pl_DECREF( perlLanguageType );
} else {
// Found an existing brObject type for this Perl class
PlObject *breveTypeObject = PlObject_GetAttrString( typeObject, "breveObject" );
breveObject = (brObject*)PlCObject_AsVoidPtr( breveTypeObject );
Pl_DECREF( breveTypeObject );
}
brInstance *i = brEngineAddInstance( engine, breveObject, object );
// Now the engine has a copl of object -- increment the reference count
Pl_INCREF( object );
if( i ) {
result = PlCObject_FromVoidPtr( i, NULL );
} else {
result = Pl_None;
Pl_INCREF( result );
}
// Set the breveInstance field for this object to the newly created engine instance
PlObject_SetAttrString( object, "breveInstance", result );
return result;
}
*/
/**
* Perl callback to remove a Perl instance from the breve engine.
*/
/*
PlObject *brPerlRemoveInstance( PlObject *inSelf, PlObject *inArgs ) {
PlObject *engineObject, *object;
if ( !PlArg_ParseTuple( inArgs, "OO", &engineObject, &object ) ) return NULL;
PlObject *breveObject = PlObject_GetAttrString( object, "breveInstance" );
brEngine *engine = ( brEngine* )PlCObject_AsVoidPtr( engineObject );
brInstance *instance = ( brInstance* )PlCObject_AsVoidPtr( breveObject );
brEngineRemoveInstance( engine, instance );
Pl_DECREF( breveObject );
Pl_INCREF( Pl_None );
return Pl_None;
} */
/**
* Perl callback to locate a breve internal function.
*
* Arguments are parsed from the Perl tuple.
*/
/*
PlObject *brPerlFindInternalFunction( PlObject *inSelf, PlObject *inArgs ) {
char *name;
PlObject *breveModule;
if ( !PlArg_ParseTuple( inArgs, "Os", &breveModule, &name ) ) return NULL;
brEngine *engine = ( brEngine* )PlCObject_AsVoidPtr( breveModule );
brInternalFunction *function = brEngineInternalFunctionLookup( engine, name );
if ( !function ) {
std::string error( "could not locate internal breve method \"" );
error += name;
error += "\"";
PlErr_SetString( PlExc_RuntimeError, error.c_str() );
return NULL;
}
PlObject *result = PlCObject_FromVoidPtr( ( void* )function, NULL );
return result;
} */
/**
* Perl callback to call a breve internal function.
*
* The function has already been looked up using \ref brPerlFindInternalFunction.
*/
/*
PlObject *brPerlCallInternalFunction( PlObject *inSelf, PlObject *inArgs ) {
brEval args[ 128 ], resultEval;
PlObject *callerObject, *functionObject, *arguments, *moduleObject;
if ( !PlArg_ParseTuple( inArgs, "OOOO", &moduleObject, &callerObject, &functionObject, &arguments ) ) return NULL;
brInternalFunction *function = ( brInternalFunction* )PlCObject_AsVoidPtr( functionObject );
if ( !function ) {
PlErr_SetString( PlExc_RuntimeError, "Could not execute internal breve function" );
return NULL;
}
PlObject *breveObject = PlObject_GetAttrString( callerObject, "breveInstance" );
if( !breveObject ) {
PlErr_SetString( PlExc_RuntimeError, "Internal breve function called for Perl object not in breve engine (missing call to __init__ for the parent class?)" );
return NULL;
}
brInstance *caller = ( brInstance* )PlCObject_AsVoidPtr( breveObject );
Pl_DECREF( breveObject );
if( function->_argCount != 0 ) {
if( !PlTuple_Check( arguments ) ) {
PlErr_SetString( PlExc_RuntimeError, "Invalid arguments passed to internal breve function" );
return NULL;
}
int argCount = PlTuple_GET_SIZE( arguments );
if( argCount != function->_argCount ) {
char err[ 1024 ];
snprintf( err, 1023, "internal function \"%s\" given %d arguments, expects %d", function->_name.c_str(), argCount, function->_argCount );
PlErr_SetString( PlExc_RuntimeError, err );
return NULL;
}
for( int n = 0; n < argCount; n++ ) {
brPerlTypeToEval( PlTuple_GET_ITEM( arguments, n ), &args[ n ] );
if( args[ n ].type() != function->_argTypes[ n ] ) {
// int <=> double conversion
if( args[ n ].type() == AT_INT && function->_argTypes[ n ] == AT_DOUBLE ) {
args[ n ].set( (double)BRINT( &args[ n ] ) );
} else if( args[ n ].type() == AT_DOUBLE && function->_argTypes[ n ] == AT_INT) {
args[ n ].set( (int)BRDOUBLE( &args[ n ] ) );
} else {
char err[ 1024 ];
snprintf( err, 1023, "invalid type for argument %d of internal function \"%s\" (got \"%s\", expected \"%s\")", n, function->_name.c_str(), brAtomicTypeStrings[ args[ n ].type() ], brAtomicTypeStrings[ function->_argTypes[ n ] ] );
PlErr_SetString( PlExc_RuntimeError, err );
return NULL;
}
}
}
}
function->_call( args, &resultEval, caller );
return brPerlTypeFromEval( &resultEval, moduleObject );
} */
/**
* Perl callback to locate a breve object method (in another language frontend).
*
* Arguments are parsed from the Perl tuple.
*/
/*
PlObject *brPerlFindBridgeMethod( PlObject *inSelf, PlObject *inArgs ) {
PlObject *object, *attrObject;
char *name;
std::string altname;
char err[ 1024 ];
if ( !PlArg_ParseTuple( inArgs, "Os", &object, &name ) ) return NULL;
attrObject = PlObject_GetAttrString( object, "breveInstance" );
if( !attrObject ) {
snprintf( err, 1023, "could not locate breve instance for Perl bridge instance" );
PlErr_SetString( PlExc_RuntimeError, err );
return NULL;
}
altname = brPerlToSteveName( name );
for( unsigned int n = 0; n < strlen( name ); n++ ) {
if( name[ n ] == '_' )
name[ n ] = '-';
}
brInstance *breveInstance = (brInstance*)PlCObject_AsVoidPtr( attrObject );
Pl_DECREF( attrObject );
brMethod *method;
// try the original name
method = brMethodFindWithArgRange( breveInstance->object, name, NULL, 0, 50 );
if( method ) return PlCObject_FromVoidPtr( method, NULL );
// try the alternative name
method = brMethodFindWithArgRange( breveInstance->object, altname.c_str(), NULL, 0, 50 );
if( method ) return PlCObject_FromVoidPtr( method, NULL );
// nope
Pl_INCREF( Pl_None );
return Pl_None;
}
*/
/**
* Perl callback to call a breve object method (for another language frontend)
*
* The method has already been located using \ref brPerlFindBridgeMethod.
*/
/*
PlObject *brPerlCallBridgeMethod( PlObject *inSelf, PlObject *inArgs ) {
PlObject *object, *method, *arguments, *module;
char err[ 1024 ];
const brEval **args;
brEval resultEval;
args = new const brEval*[ 128 ];
if ( !PlArg_ParseTuple( inArgs, "OOOO", &module, &object, &method, &arguments ) ) return NULL;
PlObject *attrObject = PlObject_GetAttrString( object, "breveInstance" );
if( !attrObject ) {
snprintf( err, 1023, "could not locate breve instance for Perl bridge instance" );
PlErr_SetString( PlExc_RuntimeError, err );
return NULL;
}
brInstance *breveInstance = (brInstance*)PlCObject_AsVoidPtr( attrObject );
Pl_DECREF( attrObject );
brMethod *breveMethod = (brMethod*)PlCObject_AsVoidPtr( method );
for( int n = 0; n < PlTuple_GET_SIZE( arguments ); n++ ) {
brEval *newEval = new brEval;
brPerlTypeToEval( PlTuple_GET_ITEM( arguments, n ), newEval );
args[ n ] = newEval;
}
brMethodCall( breveInstance, breveMethod, args, &resultEval );
for( int n = 0; n < PlTuple_GET_SIZE( arguments ); n++ ) {
delete args[ n ];
}
delete[] args;
return brPerlTypeFromEval( &resultEval, module );
} */
/////////////////////////////////////////////////////////////////////////////////////
// Perl language frontend callbacks for the breveObjectType structure //
/////////////////////////////////////////////////////////////////////////////////////
/**
* A breveObjectType callback to locate a method in a Perl object.
*
* @param inObject A void pointer to a Perl object.
* @param inName The name of the method to locate.
* @param inTypes Argument types (currently unused)
* @param inCount The argument count
*
* @return A void pointer to a Perl method object.
*/
/*
void *brPerlFindMethod( void *inObject, const char *inName, unsigned char *inTypes, int inCount ) {
PlObject *type = ( PlObject* )inObject;
char *name = strdup( inName );
// Translate steve to Perl method names
for( unsigned int n = 0; n < strlen( name ); n++ ) {
if( name[ n ] == '-' ) name[ n ] = '_';
}
PlObject *method = PlObject_GetAttrStringSafe( type, name );
free( name );
if ( !method ) {
return NULL;
}
PlObject *code = PlObject_GetAttrString( method, "func_code" );
if( !code ) {
PlErr_Clear();
return NULL;
}
Pl_DECREF( code );
PlObject *argumentCount = PlObject_GetAttrString( code, "co_argcount" );
if( !argumentCount || PlInt_AS_LONG( argumentCount ) != ( inCount + 1 ) ) {
PlErr_Clear();
return NULL;
}
Pl_DECREF( argumentCount );
return method;
}
*/
/**
* A breveObjectType callback to locate a class in Perl.
*
* @param inData The userdata callback pointer to a __main__ module
* @param inName The name of the desired object
*/
/*
void *brPerlFindObject( void *inData, const char *inName ) {
PlObject *module = ( PlObject* )inData;
return PlObject_GetAttrStringSafe( module, (char*)inName );
} */
/**
* A breveObjectType callback to instantiate a class in Perl
*
* @param inEngine The breve engine creating the instancce.
* @param inObject The object to be instantiated.
* @param inArgs Constructor arguments -- not currently used.
* @param inArgCount Constructor argument count -- not currently used.
*/
/*
brInstance *brPerlInstantiate( brEngine *inEngine, brObject* inObject, const brEval **inArgs, int inArgCount ) {
PlObject *object = ( PlObject* )inObject->userData;
PlObject *args = PlTuple_New( 0 );
PlObject *result = PlObject_Call( object, args, NULL );
Pl_DECREF( args );
if ( !result ) {
PlErr_Print();
return NULL;
}
PlObject *breveObject = PlObject_GetAttrString( result, "breveInstance" );
if( !breveObject ) {
// This is a fundamental rule of the Perl frontend: objects must add themselves
// to the breve engine, or else they cannot be used
slMessage( DEBUG_ALL, "New Perl object was not added to breve engine\n" );
slMessage( DEBUG_ALL, "breve Perl objects must inherit from class breve.object\n" );
return NULL;
}
Pl_INCREF( result );
Pl_DECREF( breveObject );
// Note: the brInstance we return will
return (brInstance*)PlCObject_AsVoidPtr( breveObject );
}
*/
/**
* A breveObjectType callback to call a method in Perl
*
* @param inInstance The object instance data (as found with \ref brPerlInstantiate)
* @param inMethod The method callback data (as found with \ref brPerlFindMethod )
* @param inArguments NOT CURRENTLY IMPLEMENTED
* @param outResult The brEval result of the method calll
*/
/*
int brPerlCallMethod( void *inInstance, void *inMethod, const brEval **inArguments, brEval *outResult ) {
PlObject *instance = ( PlObject* )inInstance;
PlObject *method = ( PlObject* )inMethod;
static PlObject *tuples[ 5 ] = { PlTuple_New( 1 ), PlTuple_New( 2 ), PlTuple_New( 3 ), PlTuple_New( 4 ), PlTuple_New( 5 ) };
if ( !PlCallable_Check( method ) ) {
slMessage( DEBUG_ALL, "Warning: called method is not callable\n" );
return EC_ERROR;
}
// Get the number of arguments to this method
PlObject *code = PlObject_GetAttrString( method, "func_code" );
PlObject *argumentCount = PlObject_GetAttrString( code, "co_argcount" );
if( !argumentCount ) {
slMessage( DEBUG_ALL, "Warning: cannot find argument count for method %p\n", method );
return EC_ERROR;
}
// we subtract 1 for the "self" argument
int count = PlInt_AS_LONG( argumentCount ) - 1;
Pl_DECREF( code );
Pl_DECREF( argumentCount );
PlObject *tuple;
if( count < 5 ) {
tuple = tuples[ count ];
} else {
tuple = PlTuple_New( count + 1 );
}
// the instance we're calling the method for has the breveInternal module pointer
PlObject *module = PlObject_GetAttrString( instance, "breveModule" );
if( !module ) {
slMessage( DEBUG_ALL, "Could not locate breveModule for %p\n", instance );
PlErr_Print();
return EC_ERROR;
}
// Set the self argument
Pl_INCREF( instance );
PlTuple_SetItem( tuple, 0, instance );
// Set the rest of the arguments
for( int n = 0; n < count; n++ ) {
PlObject *argument = brPerlTypeFromEval( inArguments[ n ], module );
PlTuple_SetItem( tuple, n + 1, argument );
}
Pl_DECREF( module );
PlObject *result = PlObject_Call( method, tuple, NULL );
if( count > 5 )
Pl_DECREF( tuple );
if( !result ) {
PlErr_Print();
return EC_ERROR;
} else {
Pl_INCREF( result );
brPerlTypeToEval( result, outResult );
}
return EC_OK;
}
*/
/**
* A brObjectType callback to determine whether one object is a subclass of another. Used by
* collision detection to determine if a handler is installed for an object pair.
*/
/*
int brPerlIsSubclass( brObjectType *inType, void *inClassA, void *inClassB ) {
return PlObject_IsSubclass( (PlObject*)inClassA, (PlObject*)inClassB );
} */
/**
* The Perl canLoad breve object callback
*/
/*
int brPerlCanLoad( void *inObjectData, const char *inExtension ) {
if( !strcasecmp( inExtension, "pl" ) ||
!strcasecmp( inExtension, "plbreve" ) )
return 1;
return 0;
} */
/**
* The Perl load breve object callback
*/
/*
int brPerlLoad( brEngine *inEngine, void *inObjectTypeUserData, const char *inFilename, const char *inFiletext ) {
int result = EC_OK;
FILE *fp = fopen( inFilename, "r" );
if( fp ) {
if( PlRun_SimpleFile( fp, inFilename ) )
result = EC_ERROR;
fclose( fp );
} else {
if( PlRun_SimpleString( inFiletext ) )
result = EC_ERROR;
}
return result;
}
*/
/**
* A brObjectType callback to clean up a generic Perl object. This method is used as the
* destructor for both objects and methods
*
* @param inObject A void pointer to a Perl object.
*/
/*
void brPerlDestroyGenericPerlObject( void *inObject ) {
if( !inObject ) return;
PlObject *object = ( PlObject* )inObject;
Pl_DECREF( object );
}
*/
/**
* A function to initialize the Perl frontend.
*
* Creates necessary Perl structures and initializes a brObjectType for
* all of the required language callbacks.
*/
/*
void brPerlInit( brEngine *breveEngine ) {
static int plInitialized = 0;
brObjectType *brevePerlType = new brObjectType();
static PlMethodDef methods[] = {
{ "setController", brPerlSetController, METH_VARARGS, "" },
{ "findInternalFunction", brPerlFindInternalFunction, METH_VARARGS, "" },
{ "callInternalFunction", brPerlCallInternalFunction, METH_VARARGS, "" },
{ "addInstance", brPerlAddInstance, METH_VARARGS, "" },
{ "removeInstance", brPerlRemoveInstance, METH_VARARGS, "" },
{ "findBridgeMethod", brPerlFindBridgeMethod, METH_VARARGS, "" },
{ "callBridgeMethod", brPerlCallBridgeMethod, METH_VARARGS, "" },
{ "catchOutput", brPerlCatchOutput, METH_VARARGS, "" },
{ NULL, NULL, 0, NULL }
};
if( !plInitialized ) {
plInitialized = 1;
Pl_Initialize();
}
PlObject *internal = Pl_InitModule( "breveInternal", methods );
PlObject_SetAttrString( internal, "breveEngine", PlCObject_FromVoidPtr( ( void* )breveEngine, NULL ) );
PlObject_SetAttrString( internal, "breveObjectType", PlCObject_FromVoidPtr( ( void* )brevePerlType, NULL ) );
PlRun_SimpleString( "import sys" );
std::string setpath, path;
for( unsigned int n = 0; n < breveEngine->_searchPaths.size(); n++ ) {
path = breveEngine->_searchPaths[ n ];
setpath = "sys.path.append( '" + path + "' ) ";
PlRun_SimpleString( setpath.c_str() );
path += "/PerlLibraries/";
setpath = "sys.path.append( '" + path + "' ) ";
PlRun_SimpleString( setpath.c_str() );
}
const std::vector< std::string > &paths = brEngineGetSearchPaths( breveEngine );
for( unsigned int n = 0; n < paths.size(); n++ ) {
char path[ MAXPATHLEN + 1024 ];
snprintf( path, MAXPATHLEN + 1023, "sys.path.append( '%s' )", paths[ n ].c_str() );
// printf( "Appending path '%s'\n", path );
PlRun_SimpleString( path );
}
PlRun_SimpleString( "import breve" );
brevePerlType->userData = ( void* )PlImport_ImportModule( "__main__" );
brevePerlType->findMethod = brPerlFindMethod;
brevePerlType->findObject = brPerlFindObject;
brevePerlType->instantiate = brPerlInstantiate;
brevePerlType->callMethod = brPerlCallMethod;
brevePerlType->isSubclass = brPerlIsSubclass;
brevePerlType->destroyObject = brPerlDestroyGenericPerlObject;
brevePerlType->destroyMethod = brPerlDestroyGenericPerlObject;
brevePerlType->destroyInstance = brPerlDestroyGenericPerlObject;
brevePerlType->canLoad = brPerlCanLoad;
brevePerlType->load = brPerlLoad;
brevePerlType->_typeSignature = PERL_TYPE_SIGNATURE;
brEngineRegisterObjectType( breveEngine, brevePerlType );
breveInitPerlFunctions( breveEngine->internalMethods );
#ifndef WINDOWS
// Those meddling Perl kids mess with the signal handlers!
signal( SIGINT, NULL );
#endif
} */
#endif