adding callback stuff, still gotta test it

git-svn-id: http://svn.freeswitch.org/svn/freeswitch/trunk@8241 d0543943-73ff-0310-b7d9-9358b9ac24b2

src/mod/languages/mod_perl/Makefile

@@ -15,6 +15,10 @@ swigclean: clean
 
 mod_perl_wrap.cpp:
 	swig -static -shadow -perl5 -c++ -DMULTIPLICITY -I../../../../src/include -o mod_perl_wrap.cpp freeswitch.i
+	echo "#include \"mod_perl_extra.c\"" >> mod_perl_wrap.cpp
+	patch -s -p0 -i hack.diff
+
+
 
 freeswitch.$(DYNAMIC_LIB_EXTEN): $(LOCAL_OBJS) $(LOCAL_LIBADD)
 	$(LINK) $(SOLINK) -o freeswitch.$(DYNAMIC_LIB_EXTEN)  $(LOCAL_OBJS) $(LOCAL_LIBADD) $(LDFLAGS)

src/mod/languages/mod_perl/freeswitch.pm

@@ -333,6 +333,16 @@ sub DESTROY {
 *end_allow_threads = *freeswitchc::Session_end_allow_threads;
 *check_hangup_hook = *freeswitchc::Session_check_hangup_hook;
 *run_dtmf_callback = *freeswitchc::Session_run_dtmf_callback;
+*setInputCallback = *freeswitchc::Session_setInputCallback;
+*setHangupHook = *freeswitchc::Session_setHangupHook;
+*ready = *freeswitchc::Session_ready;
+*swig_cb_function_get = *freeswitchc::Session_cb_function_get;
+*swig_cb_function_set = *freeswitchc::Session_cb_function_set;
+*swig_cb_arg_get = *freeswitchc::Session_cb_arg_get;
+*swig_cb_arg_set = *freeswitchc::Session_cb_arg_set;
+*swig_hangup_func_str_get = *freeswitchc::Session_hangup_func_str_get;
+*swig_hangup_func_str_set = *freeswitchc::Session_hangup_func_str_set;
+*setPERL = *freeswitchc::Session_setPERL;
 sub DISOWN {
     my $self = shift;
     my $ptr = tied(%$self);

src/mod/languages/mod_perl/freeswitch_perl.cpp

+#include <switch.h>
 #include "freeswitch_perl.h"
+#include "mod_perl_extra.h"
+
+static STRLEN n_a;
 
 Session::Session() : CoreSession()
 {
-	
+	cb_function = cb_arg = hangup_func_str = NULL;
+	hh = mark = 0;
 }
 
 Session::Session(char *uuid) : CoreSession(uuid)
 {
-	
+	cb_function = cb_arg = hangup_func_str = NULL;
+	hh = mark = 0;
 }
 
 Session::Session(switch_core_session_t *new_session) : CoreSession(new_session)
 {
-
+	cb_function = cb_arg = hangup_func_str = NULL;
+	hh = mark = 0;
 }
-
-Session::~Session() 
+static switch_status_t perl_hanguphook(switch_core_session_t *session_hungup);
+Session::~Session()
 {
-	
+	switch_safe_free(cb_function);
+	switch_safe_free(cb_arg);
+	switch_safe_free(hangup_func_str);
+	switch_core_event_hook_remove_state_change(session, perl_hanguphook);
 }
 
-
 bool Session::begin_allow_threads() 
 {
+	do_hangup_hook();
 	return true;
 }
 
 bool Session::end_allow_threads() 
 {
+	do_hangup_hook();
 	return true;
 }
 
+void Session::setPERL(PerlInterpreter *pi)
+{
+	my_perl = pi;
+}
+
+PerlInterpreter *Session::getPERL()
+{
+	if (!my_perl) {
+		switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "Doh!\n");		
+	}
+	return my_perl;
+}
+
+
+bool Session::ready() {
+	bool r;
+
+	sanity_check(false);	
+	r = switch_channel_ready(channel) != 0;
+	do_hangup_hook();
+
+	return r;
+}
+
 void Session::check_hangup_hook() 
 {
+	if (hangup_func_str && (hook_state == CS_HANGUP || hook_state == CS_RING)) {
+		hh++;
+	}
 }
 
-switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t itype) 
+void Session::do_hangup_hook() 
 {
-	return SWITCH_STATUS_FALSE;
+	if (hh && !mark) {
+		const char *err = NULL;
+		mark++;
+		char *code;
+		if (!getPERL()) {
+			return;
+		}
+
+		code = switch_mprintf("%s(%s)", hangup_func_str, hook_state == CS_HANGUP ? "hangup" : "transfer");
+		Perl_eval_pv(my_perl, code, TRUE);
+		free(code);
+	}
+}
+
+static switch_status_t perl_hanguphook(switch_core_session_t *session_hungup) 
+{
+	switch_channel_t *channel = switch_core_session_get_channel(session_hungup);
+	CoreSession *coresession = NULL;
+	switch_channel_state_t state = switch_channel_get_state(channel);
+
+	if ((coresession = (CoreSession *) switch_channel_get_private(channel, "CoreSession"))) {
+		if (coresession->hook_state != state) {
+			coresession->hook_state = state;
+			coresession->check_hangup_hook();
+		}
+	}
+
+	return SWITCH_STATUS_SUCCESS;
 }
 
 
-#if 0
-int Session::answer() {}
-int Session::preAnswer() {}
-void Session::hangup(char *cause) {}
-void Session::setVariable(char *var, char *val) {}
-const char *Session::getVariable(char *var) {}
-int Session::recordFile(char *file_name, int max_len, int silence_threshold, int silence_secs) {}
-void Session::setCallerData(char *var, char *val) {}
-int Session::originate(CoreSession *a_leg_session, char *dest, int timeout) {}
-void Session::setDTMFCallback(void *cbfunc, char *funcargs) {}
-int Session::speak(char *text) {}
-void Session::set_tts_parms(char *tts_name, char *voice_name) {}
-int Session::collectDigits(int timeout) {}
-int Session::getDigits(char *dtmf_buf, 
-			  switch_size_t buflen, 
-			  switch_size_t maxdigits, 
-			  char *terminators, 
-			  char *terminator, 
-			  int timeout) {}
-
-int Session::transfer(char *extensions, char *dialplan, char *context) {}
-int Session::playAndGetDigits(int min_digits, 
-					 int max_digits, 
-					 int max_tries, 
-					 int timeout, 
-					 char *terminators,
-					 char *audio_files, 
-					 char *bad_input_audio_files, 
-					 char *dtmf_buf, 
-					 char *digits_regex) {}
-
-int Session::streamFile(char *file, int starting_sample_count) {}
-int Session::flushEvents() {}
-int Session::flushDigits() {}
-int Session::setAutoHangup(bool val) {}
-void Session::setHangupHook(void *hangup_func) {}
-bool Session::ready() {}
-void Session::execute(char *app, char *data) {}
-char* Session::get_uuid() {}
-const switch_input_args_t& Session::get_cb_args() {}
-
-#endif
+void Session::setHangupHook(char *func) {
+
+	sanity_check_noreturn;
+
+	switch_safe_free(hangup_func_str);
+
+	if (func) {
+		hangup_func_str = strdup(func);
+		switch_channel_set_private(channel, "CoreSession", this);
+		hook_state = switch_channel_get_state(channel);
+		switch_core_event_hook_add_state_change(session, perl_hanguphook);
+	}
+}
+
+void Session::setInputCallback(char *cbfunc, char *funcargs) {
+
+	sanity_check_noreturn;
+
+	switch_safe_free(cb_function);
+	if (cbfunc) {
+		cb_function = strdup(cbfunc);
+	}
+
+	switch_safe_free(cb_arg);
+	if (funcargs) {
+		cb_arg = strdup(funcargs);
+	}
+	
+	args.buf = this;
+	switch_channel_set_private(channel, "CoreSession", this);
+
+	args.input_callback = dtmf_callback;  
+	ap = &args;
+}
+
+switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t itype) 
+{
+	const char *ret;
+
+	if (!getPERL()) {
+		return SWITCH_STATUS_FALSE;;
+	}
+
+	switch (itype) {
+    case SWITCH_INPUT_TYPE_DTMF:
+		{
+			switch_dtmf_t *dtmf = (switch_dtmf_t *) input;
+			char str[32] = "";
+			int arg_count = 2;
+			HV *hash;
+			SV *this_sv;
+			char *code;
+
+			if (!(hash = get_hv("__dtmf", TRUE))) {
+				abort();
+			}
+
+			str[0] = dtmf->digit;
+			this_sv = newSV(strlen(str)+1);
+			sv_setpv(this_sv, str);
+			hv_store(hash, "digit", 5, this_sv, 0);
+
+			switch_snprintf(str, sizeof(str), "%d", dtmf->duration);
+			this_sv = newSV(strlen(str)+1);
+			sv_setpv(this_sv, str);
+			hv_store(hash, "duration", 8, this_sv, 0);			
+
+			if (cb_arg) {
+				//this_sv = get_sv(cb_arg, TRUE); DOH!
+			}
+			
+			code = switch_mprintf("%s('dtmf', \\%__dtmf, %s);", cb_function, switch_str_nil(cb_arg));
+			Perl_eval_pv(my_perl, code, TRUE);
+			free(code);
+
+			return process_callback_result(SvPV(get_sv(cb_function, FALSE), n_a));
+		}
+		break;
+    case SWITCH_INPUT_TYPE_EVENT:
+		{
+			switch_event_t *event = (switch_event_t *) input;
+			int arg_count = 2;
+			char *code;
+
+			mod_perl_conjure_event(my_perl, event, "__Input_Event__");
+			
+			code = switch_mprintf("%s('event', $__Input_Event__, %s);", cb_function, switch_str_nil(cb_arg));
+			Perl_eval_pv(my_perl, code, TRUE);
+			free(code);
+			
+			
+            return process_callback_result((char *)ret);			
+		}
+		break;
+	}
+
+	return SWITCH_STATUS_SUCCESS;
+}

src/mod/languages/mod_perl/freeswitch_perl.h

-#ifndef FREESWITCH_PYTHON_H
-#define FREESWITCH_PYTHON_H
+#ifndef FREESWITCH_LUA_H
+#define FREESWITCH_LUA_H
 
-#include <switch_cpp.h>
+extern "C" {
+#ifdef __ICC
+#pragma warning (disable:1419)
+#endif
+#ifdef _MSC_VER
+#include <perlibs.h>
+#pragma comment(lib, PERL_LIB)
+#endif
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <switch.h>
+}
 
+#include <switch_cpp.h>
 
 class Session : public CoreSession {
  private:
+	virtual void do_hangup_hook();
+	PerlInterpreter *getPERL();
+	PerlInterpreter *my_perl;
+	int hh;
+	int mark;
  public:
     Session();
     Session(char *uuid);
     Session(switch_core_session_t *session);
     ~Session();        
-
+	
 	virtual bool begin_allow_threads();
 	virtual bool end_allow_threads();
 	virtual void check_hangup_hook();
-	virtual switch_status_t run_dtmf_callback(void *input, switch_input_type_t itype);
 
+	virtual switch_status_t run_dtmf_callback(void *input, switch_input_type_t itype);
+	void setInputCallback(char *cbfunc, char *funcargs);
+	void setHangupHook(char *func);
+	bool ready();
+	
+	char *cb_function;
+	char *cb_arg;
+	char *hangup_func_str;
+	void setPERL(PerlInterpreter *pi);
 };
 
 #endif

src/mod/languages/mod_perl/hack.diff

+--- mod_perl_wrap.cpp	2008-05-01 18:05:28.000000000 -0400
++++ old.cpp	2008-05-01 18:05:51.000000000 -0400
+
+@@ -6293,7 +6293,7 @@
+     if ((items < 0) || (items > 0)) {
+       SWIG_croak("Usage: new_Session();");
+     }
+-    result = (Session *)new Session();
++    result = (Session *)new Session(); result->setPERL(my_perl);
+     ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
+     XSRETURN(argvi);
+   fail:
+@@ -6320,7 +6320,7 @@
+       SWIG_exception_fail(SWIG_ArgError(res1), "in method '" "new_Session" "', argument " "1"" of type '" "char *""'");
+     }
+     arg1 = reinterpret_cast< char * >(buf1);
+-    result = (Session *)new Session(arg1);
++    result = (Session *)new Session(arg1); result->setPERL(my_perl);
+     ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
+     if (alloc1 == SWIG_NEWOBJ) delete[] buf1;
+     XSRETURN(argvi);
+@@ -6348,7 +6348,7 @@
+       SWIG_exception_fail(SWIG_ArgError(res1), "in method '" "new_Session" "', argument " "1"" of type '" "switch_core_session_t *""'"); 
+     }
+     arg1 = reinterpret_cast< switch_core_session_t * >(argp1);
+-    result = (Session *)new Session(arg1);
++    result = (Session *)new Session(arg1); result->setPERL(my_perl);
+     ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
+     
+     XSRETURN(argvi);

src/mod/languages/mod_perl/mod_perl.c

@@ -56,19 +56,87 @@ static struct {
 	char *xml_handler;
 } globals;
 
-static int Perl_safe_eval(PerlInterpreter *my_perl, const char *string, int tf)
+
+
+static int Perl_safe_eval(PerlInterpreter *my_perl, const char *string)
 {
 	char *err = NULL;
 
 	Perl_eval_pv(my_perl, string, FALSE);
 
 	if ((err = SvPV(get_sv("@", TRUE), n_a)) && !switch_strlen_zero(err)) {
-		switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "%s\n", err);
+		switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "[%s]\n%s\n", string, err);
 		return -1;
 	}
 	return 0;
 }
 
+
+
+static int perl_parse_and_execute(PerlInterpreter *my_perl, char *input_code, char *setup_code)
+{
+	int error = 0;
+
+	if (switch_strlen_zero(input_code)) {
+		switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "No code to execute!\n");
+		return -1;
+	}
+
+	if (setup_code) {
+		error = Perl_safe_eval(my_perl, setup_code);
+		if (error) {
+			return error;
+		}
+	}
+
+	if (*input_code == '~') {
+		char *buff = input_code + 1;
+		error = Perl_safe_eval(my_perl, buff);
+	} else {
+		char *args = strchr(input_code, ' ');
+		if (args) {
+			char *code = NULL;
+			int x, argc;
+			char *argv[128] = { 0 };
+			*args++ = '\0';
+
+			if ((argc = switch_separate_string(args, ' ', argv, (sizeof(argv) / sizeof(argv[0]))))) {
+				switch_stream_handle_t stream = { 0 };
+				SWITCH_STANDARD_STREAM(stream);
+				
+				stream.write_function(&stream, " @ARGV = ( ");
+				for (x = 0; x < argc; x++) {
+					stream.write_function(&stream, "'%s'%s", argv[x], x == argc-1 ? "" : ", ");
+				}
+				stream.write_function(&stream, " );");
+				code = stream.data;
+			} else {
+				code = switch_mprintf("ARGV = ();");
+			}
+
+			if (code) {
+				error = Perl_safe_eval(my_perl, code);
+				switch_safe_free(code);
+			}
+		}
+		if (!error) {
+			char *file = input_code;
+			
+			if (!switch_is_file_path(file)) {
+				file = switch_mprintf("require '%s/%s';\n", SWITCH_GLOBAL_dirs.script_dir, file);
+				switch_assert(file);
+			} else {
+				file = switch_mprintf("require '%s';\n", file);
+				switch_assert(file);
+			}
+			error = Perl_safe_eval(my_perl, file);
+			switch_safe_free(file);
+		}
+	}
+
+	return error;
+}
+
 static void destroy_perl(PerlInterpreter ** to_destroy)
 {
 	perl_destruct(*to_destroy);
@@ -83,6 +151,7 @@ static PerlInterpreter *clone_perl(void)
 	return my_perl;
 }
 
+#if 0
 static perl_parse_and_execute (PerlInterpreter *my_perl, char *input_code, char *setup_code)
 {
 	int error = 0;
@@ -90,8 +159,8 @@ static perl_parse_and_execute (PerlInterpreter *my_perl, char *input_code, char
 	if (*input_code == '~') {
 		char *buff = input_code + 1;
 		perl_parse(my_perl, xs_init, 3, embedding, NULL);
-		if (setup_code) Perl_safe_eval(my_perl, setup_code, FALSE);
-		Perl_safe_eval(my_perl, buff, TRUE);
+		if (setup_code) Perl_safe_eval(my_perl, setup_code);
+		Perl_safe_eval(my_perl, buff);
 	} else {
 		int argc = 0;
 		char *argv[128] = { 0 };
@@ -102,7 +171,7 @@ static perl_parse_and_execute (PerlInterpreter *my_perl, char *input_code, char
 		argc += switch_separate_string(input_code, ' ', &argv[1], (sizeof(argv) / sizeof(argv[0])) - 1);
 		if (!perl_parse(my_perl, xs_init, argc, argv, (char **)NULL)) {
 			if (setup_code) {
-				if (!Perl_safe_eval(my_perl, setup_code, FALSE)) {
+				if (!Perl_safe_eval(my_perl, setup_code)) {
 					perl_run(my_perl);
 				}
 			}
@@ -115,13 +184,17 @@ static perl_parse_and_execute (PerlInterpreter *my_perl, char *input_code, char
 
 	}
 }
+#endif 
 
 static void perl_function(switch_core_session_t *session, char *data)
 {
 	char *uuid = switch_core_session_get_uuid(session);
 	PerlInterpreter *my_perl = clone_perl();
-	
 	char code[1024];
+	
+	perl_parse(my_perl, xs_init, 3, embedding, NULL);
+	Perl_safe_eval(my_perl, code);
+
 	switch_snprintf(code, sizeof(code), 
 			"use lib '%s/perl';\n"
 			"use freeswitch;\n"
@@ -133,15 +206,14 @@ static void perl_function(switch_core_session_t *session, char *data)
 			uuid);
 
 	perl_parse_and_execute(my_perl, data, code);
-	Perl_safe_eval(my_perl, "undef $session;", FALSE);
-	Perl_safe_eval(my_perl, "undef (*);", FALSE);
+	Perl_safe_eval(my_perl, "undef $session;");
+	Perl_safe_eval(my_perl, "undef (*);");
 	destroy_perl(&my_perl);
 }
 
 SWITCH_MODULE_SHUTDOWN_FUNCTION(mod_perl_shutdown)
 {
 	if (globals.my_perl) {
-		perl_destruct(globals.my_perl);
 		perl_free(globals.my_perl);
 		globals.my_perl = NULL;
 		switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_INFO, "Unallocated perl interpreter.\n");
@@ -149,28 +221,71 @@ SWITCH_MODULE_SHUTDOWN_FUNCTION(mod_perl_shutdown)
 	return SWITCH_STATUS_SUCCESS;
 }
 
+struct perl_o {
+	switch_stream_handle_t *stream;
+	switch_core_session_t *session;
+	char *cmd;
+	int d;
+};
+
 static void *SWITCH_THREAD_FUNC perl_thread_run(switch_thread_t *thread, void *obj)
 {
-	char *input_code = (char *) obj;
 	PerlInterpreter *my_perl = clone_perl();
 	char code[1024];
+	SV *sv = NULL;
+	char *uuid = NULL;
+	struct perl_o *po = (struct perl_o *) obj;
+	char *cmd = po->cmd;
+	switch_stream_handle_t *stream = po->stream;
+	switch_core_session_t *session = po->session;
 
+	if (session) {
+		uuid = switch_core_session_get_uuid(session);
+	}
+	
 	switch_snprintf(code, sizeof(code), 
-			"use lib '%s/perl';\n"
-			"use freeswitch;\n"
-			, 
-			SWITCH_GLOBAL_dirs.base_dir 
-			);
+					"use lib '%s/perl';\n"
+					"use freeswitch;\n"			
+					"$SWITCH_ENV{UUID} = \"%s\";\n"
+					,
+
+					SWITCH_GLOBAL_dirs.base_dir,
+					switch_str_nil(uuid)
+					);
+
+	perl_parse(my_perl, xs_init, 3, embedding, NULL);
+	Perl_safe_eval(my_perl, code);
+
+	if (uuid) {
+		switch_snprintf(code, sizeof(code), "$session = new freeswitch::Session(\"%s\")", uuid);
+		Perl_safe_eval(my_perl, code);
+	}
 
-	perl_parse_and_execute(my_perl, input_code, code);
+	if (cmd) {
+		if (stream) {
+			mod_perl_conjure_stream(my_perl, stream, "stream");
+			if (stream->event) {
+				mod_perl_conjure_event(my_perl, stream->event, "env");
+			}
+		}
+		//Perl_safe_eval(my_perl, cmd);
+		perl_parse_and_execute(my_perl, cmd, NULL);
+	}
 	
-	if (input_code) {
-		free(input_code);
+	if (uuid) {
+		switch_snprintf(code, sizeof(code), "undef $session;", uuid);
+		Perl_safe_eval(my_perl, code);
 	}
 
-	Perl_safe_eval(my_perl, "undef(*);", FALSE);
+	Perl_safe_eval(my_perl, "undef(*);");
 	destroy_perl(&my_perl);
 
+	switch_safe_free(cmd);
+
+	if (po->d) {
+		free(po);
+	}
+
 	return NULL;
 }
 
@@ -178,11 +293,17 @@ int perl_thread(const char *text)
 {
 	switch_thread_t *thread;
 	switch_threadattr_t *thd_attr = NULL;
+	struct perl_o *po;
 
+	po = malloc(sizeof(*po));
+	memset(po, 0, sizeof(*po));
+	po->cmd = strdup(text);
+	po->d = 1;
+	
 	switch_threadattr_create(&thd_attr, globals.pool);
 	switch_threadattr_detach_set(thd_attr, 1);
 	switch_threadattr_stacksize_set(thd_attr, SWITCH_THREAD_STACKSIZE);
-	switch_thread_create(&thread, thd_attr, perl_thread_run, strdup(text), globals.pool);
+	switch_thread_create(&thread, thd_attr, perl_thread_run, po, globals.pool);
 
 	return 0;
 }
@@ -195,51 +316,11 @@ SWITCH_STANDARD_API(perlrun_api_function) {
 
 SWITCH_STANDARD_API(perl_api_function) {
 
-	PerlInterpreter *my_perl = clone_perl();
-	char code[1024];
-	SV *sv = NULL;
-	char *uuid = NULL;
-
-	if (session) {
-		uuid = switch_core_session_get_uuid(session);
-	}
-
-	switch_snprintf(code, sizeof(code), 
-			"use lib '%s/perl';\n"
-			"use freeswitch;\n"			
-			"$SWITCH_ENV{UUID} = \"%s\";\n"
-			"use IO::String;\n"
-			"$handle = IO::String->new($__OUT);\n"
-			"select($handle);"
-			,
-
-			SWITCH_GLOBAL_dirs.base_dir,
-			switch_str_nil(uuid)
-			);
-
-	perl_parse(my_perl, xs_init, 3, embedding, NULL);
-	Perl_safe_eval(my_perl, code, FALSE);
-
-	if (uuid) {
-		switch_snprintf(code, sizeof(code), "$session = new freeswitch::Session(\"%s\")", uuid);
-		Perl_safe_eval(my_perl, code, FALSE);
-	}
-
-	if (cmd) {
-		Perl_safe_eval(my_perl, cmd, FALSE);
-	}
-
-	stream->write_function(stream, "%s", switch_str_nil(SvPV(get_sv("__OUT", FALSE), n_a)));
-
-	if (uuid) {
-		switch_snprintf(code, sizeof(code), "undef $session;", uuid);
-		Perl_safe_eval(my_perl, code, FALSE);
-	}
-
-	Perl_safe_eval(my_perl, "undef(*);", FALSE);
-	destroy_perl(&my_perl);
-
-	return SWITCH_STATUS_SUCCESS;
+	struct perl_o po = { 0 };
+	po.cmd = strdup(cmd);
+	po.stream = stream;
+	po.session = session;
+	perl_thread_run(NULL, &po);
 }
 
 static switch_xml_t perl_fetch(const char *section, 
@@ -326,7 +407,7 @@ static switch_xml_t perl_fetch(const char *section,
 						,
 						SWITCH_GLOBAL_dirs.base_dir
 						);
-		Perl_safe_eval(my_perl, code, FALSE);
+		Perl_safe_eval(my_perl, code);
 
 		perl_run(my_perl);
 		str = SvPV(get_sv("XML_STRING", FALSE), n_a);

src/mod/languages/mod_perl/mod_perl_extra.c

+SWITCH_BEGIN_EXTERN_C
+
+
+void mod_perl_conjure_event(PerlInterpreter *my_perl, switch_event_t *event, const char *name)
+{
+    Event *result = 0 ;
+	SV *sv;
+	PERL_SET_CONTEXT(my_perl);
+	sv =  sv_2mortal(get_sv(name, TRUE));
+	result = (Event *)new Event(event);
+	SWIG_Perl_MakePtr(sv, result, SWIGTYPE_p_Event, SWIG_OWNER | SWIG_SHADOW);
+}
+
+
+void mod_perl_conjure_stream(PerlInterpreter *my_perl, switch_stream_handle_t *stream, const char *name)
+{
+    Stream *result = 0 ;
+	SV *sv;
+	PERL_SET_CONTEXT(my_perl);
+	sv =  sv_2mortal(get_sv(name, TRUE));
+	result = (Stream *)new Stream(stream);
+	SWIG_Perl_MakePtr(sv, result, SWIGTYPE_p_Stream, SWIG_OWNER | SWIG_SHADOW);
+}
+
+
+
+SWITCH_END_EXTERN_C

src/mod/languages/mod_perl/mod_perl_extra.h

+#ifndef MOD_PERL_EXTRA
+#define MOD_PERL_EXTRA
+SWITCH_BEGIN_EXTERN_C
+
+void mod_perl_conjure_event(PerlInterpreter *my_perl, switch_event_t *event, const char *name);
+void mod_perl_conjure_stream(PerlInterpreter *my_perl, switch_stream_handle_t *stream, const char *name);
+
+SWITCH_END_EXTERN_C
+#endif