fixup mod_perl

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

src/mod/languages/mod_perl/Makefile

@@ -10,13 +10,15 @@ VERBOSE=1
 include $(BASE)/build/modmake.rules
 
 
+reswig:	swigclean mod_perl_wrap.cpp
+
 swigclean: clean
 	rm -f mod_perl_wrap.* freeswitch.so freeswitch.pm
 
 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
+	patch -s -p0 -i hack.diff
 
 
 

src/mod/languages/mod_perl/freeswitch.pm

@@ -391,6 +391,12 @@ sub DESTROY {
 *swig_cb_state_set = *freeswitchc::CoreSession_cb_state_set;
 *swig_hook_state_get = *freeswitchc::CoreSession_hook_state_get;
 *swig_hook_state_set = *freeswitchc::CoreSession_hook_state_set;
+*swig_uuid_get = *freeswitchc::CoreSession_uuid_get;
+*swig_uuid_set = *freeswitchc::CoreSession_uuid_set;
+*swig_tts_name_get = *freeswitchc::CoreSession_tts_name_get;
+*swig_tts_name_set = *freeswitchc::CoreSession_tts_name_set;
+*swig_voice_name_get = *freeswitchc::CoreSession_voice_name_get;
+*swig_voice_name_set = *freeswitchc::CoreSession_voice_name_set;
 *answer = *freeswitchc::CoreSession_answer;
 *preAnswer = *freeswitchc::CoreSession_preAnswer;
 *hangup = *freeswitchc::CoreSession_hangup;
@@ -473,9 +479,12 @@ 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;
+*setME = *freeswitchc::Session_setME;
 *setInputCallback = *freeswitchc::Session_setInputCallback;
 *setHangupHook = *freeswitchc::Session_setHangupHook;
 *ready = *freeswitchc::Session_ready;
+*swig_suuid_get = *freeswitchc::Session_suuid_get;
+*swig_suuid_set = *freeswitchc::Session_suuid_set;
 *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;

src/mod/languages/mod_perl/freeswitch_perl.cpp

@@ -16,11 +16,26 @@ Session::Session():CoreSession()
 Session::Session(char *uuid):CoreSession(uuid)
 {
 	init_me();
+	suuid = switch_core_session_sprintf(session, "main::uuid_%s\n", switch_core_session_get_uuid(session));
+	for (char *p = suuid; p && *p; p++) {
+		if (*p == '-') {
+			*p = '_';
+		}
+		if (*p == '\n') {
+			*p = '\0';
+		}
+	}
 }
 
 Session::Session(switch_core_session_t *new_session):CoreSession(new_session)
 {
 	init_me();
+	suuid = switch_core_session_sprintf(session, "main::uuid_%s\n", switch_core_session_get_uuid(session));
+	for (char *p = suuid; p && *p; p++) {
+		if (*p == '-') {
+			*p = '_';
+		}
+	}
 }
 static switch_status_t perl_hanguphook(switch_core_session_t *session_hungup);
 Session::~Session()
@@ -54,6 +69,11 @@ void Session::setPERL(PerlInterpreter * pi)
 	my_perl = pi;
 }
 
+void Session::setME(SV *p)
+{
+	me = p;
+}
+
 PerlInterpreter *Session::getPERL()
 {
 	if (!my_perl) {
@@ -92,13 +112,13 @@ void Session::do_hangup_hook()
 		}
 
 		if (hangup_func_arg) {
-			code = switch_mprintf("%s(%s,%s)", hangup_func_str, hook_state == CS_HANGUP ? "hangup" : "transfer", hangup_func_arg);
-		} else {
-			code = switch_mprintf("%s(%s)", hangup_func_str, hook_state == CS_HANGUP ? "hangup" : "transfer");
-		}
+            code = switch_mprintf("%s($%s,\"%s\",%s)", hangup_func_str, suuid, hook_state == CS_HANGUP ? "hangup" : "transfer", hangup_func_arg);
+        } else {
+            code = switch_mprintf("%s($%s,\"%s\")", hangup_func_str, suuid, hook_state == CS_HANGUP ? "hangup" : "transfer");
+        }
 
-		Perl_eval_pv(my_perl, code, TRUE);
-		free(code);
+        Perl_eval_pv(my_perl, code, TRUE);
+        free(code);
 	}
 }
 
@@ -189,7 +209,7 @@ switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t ityp
 			sv_setpv(this_sv, str);
 			hv_store(hash, "duration", 8, this_sv, 0);
 
-			code = switch_mprintf("$__RV = %s('dtmf', \\%%__dtmf, %s);", cb_function, switch_str_nil(cb_arg));
+			code = switch_mprintf("$__RV = %s($%s, 'dtmf', \\%%__dtmf, %s);", cb_function, suuid, switch_str_nil(cb_arg));
 			Perl_eval_pv(my_perl, code, FALSE);
 			free(code);
 
@@ -204,7 +224,7 @@ switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t ityp
 
 			mod_perl_conjure_event(my_perl, event, "__Input_Event__");
 
-			code = switch_mprintf("$__RV = %s('event', $__Input_Event__, %s);", cb_function, switch_str_nil(cb_arg));
+			code = switch_mprintf("$__RV = %s($%s, 'event', $__Input_Event__, %s);", cb_function, suuid, switch_str_nil(cb_arg));
 			Perl_eval_pv(my_perl, code, TRUE);
 			free(code);
 

src/mod/languages/mod_perl/freeswitch_perl.h

@@ -25,6 +25,7 @@ class Session : public CoreSession {
 	PerlInterpreter *my_perl;
 	int hh;
 	int mark;
+	SV *me;
  public:
     Session();
     Session(char *uuid);
@@ -36,10 +37,11 @@ class Session : public CoreSession {
 	virtual void check_hangup_hook();
 
 	virtual switch_status_t run_dtmf_callback(void *input, switch_input_type_t itype);
-	void setInputCallback(char *cbfunc, char *funcargs);
+	void setME(SV *p);
+	void setInputCallback(char *cbfunc = "on_input", char *funcargs = NULL);
 	void setHangupHook(char *func, char *arg=NULL);
 	bool ready();
-	
+	char *suuid;
 	char *cb_function;
 	char *cb_arg;
 	char *hangup_func_str;

src/mod/languages/mod_perl/hack.diff

---- mod_perl_wrap2.cpp	2008-05-11 20:28:24.000000000 -0400
-+++ mod_perl_wrap.cpp	2008-05-11 20:26:06.000000000 -0400
-@@ -6754,7 +6754,7 @@
+--- mod_perl_wrap.cpp	2008-07-14 15:52:35.000000000 -0400
++++ old.cpp	2008-07-14 15:52:01.000000000 -0400
+@@ -8852,13 +8852,17 @@
+   {
+     PERL::Session *result = 0 ;
+     int argvi = 0;
++    SV *foo;
+     dXSARGS;
+-    
++
      if ((items < 0) || (items > 0)) {
        SWIG_croak("Usage: new_Session();");
      }
--    result = (PERL::Session *)new PERL::Session(); result->setPERL(my_perl);
-+    result = (PERL::Session *)new PERL::Session();
-     ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
+-    result = (PERL::Session *)new PERL::Session();
+-    ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
++    result = (PERL::Session *)new PERL::Session(); 
++	foo = get_sv("foo", TRUE);
++	SWIG_MakePtr(foo, SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW);
++	result->setME(foo);	
++	ST(argvi) = foo; argvi++ ;
      XSRETURN(argvi);
    fail:
-@@ -6781,7 +6781,7 @@
+     SWIG_croak_null();
+@@ -8874,6 +8878,7 @@
+     char *buf1 = 0 ;
+     int alloc1 = 0 ;
+     int argvi = 0;
++	SV *foo;
+     dXSARGS;
+     
+     if ((items < 1) || (items > 1)) {
+@@ -8884,9 +8889,13 @@
        SWIG_exception_fail(SWIG_ArgError(res1), "in method '" "new_Session" "', argument " "1"" of type '" "char *""'");
      }
      arg1 = reinterpret_cast< char * >(buf1);
--    result = (PERL::Session *)new PERL::Session(arg1); result->setPERL(my_perl);
-+    result = (PERL::Session *)new PERL::Session(arg1);
-     ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
+-    result = (PERL::Session *)new PERL::Session(arg1);
+-    ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
++    result = (PERL::Session *)new PERL::Session(arg1); result->setPERL(my_perl);
++	foo = get_sv(result->suuid, TRUE);
++	SWIG_MakePtr(foo, SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW);
++	result->setME(foo);	
++	ST(argvi) = foo; argvi++ ;
      if (alloc1 == SWIG_NEWOBJ) delete[] buf1;
++
      XSRETURN(argvi);
-@@ -6809,7 +6809,7 @@
-       SWIG_exception_fail(SWIG_ArgError(res1), "in method '" "new_Session" "', argument " "1"" of type '" "switch_core_session_t *""'"); 
+   fail:
+     if (alloc1 == SWIG_NEWOBJ) delete[] buf1;
+@@ -8902,6 +8911,7 @@
+     void *argp1 = 0 ;
+     int res1 = 0 ;
+     int argvi = 0;
++    SV *foo;
+     dXSARGS;
+     
+     if ((items < 1) || (items > 1)) {
+@@ -8913,8 +8923,11 @@
      }
      arg1 = reinterpret_cast< switch_core_session_t * >(argp1);
--    result = (PERL::Session *)new PERL::Session(arg1); result->setPERL(my_perl);
-+    result = (PERL::Session *)new PERL::Session(arg1);
-     ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
-     
+     result = (PERL::Session *)new PERL::Session(arg1);
+-    ST(argvi) = SWIG_NewPointerObj(SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW); argvi++ ;
+-    
++	foo = get_sv(result->suuid, TRUE);
++	SWIG_MakePtr(foo, SWIG_as_voidptr(result), SWIGTYPE_p_PERL__Session, SWIG_OWNER | SWIG_SHADOW);
++	result->setME(foo);	
++	ST(argvi) = foo; argvi++ ;
++	
      XSRETURN(argvi);
+   fail:
+     

src/mod/languages/mod_perl/mod_perl.c

@@ -139,8 +139,11 @@ static int perl_parse_and_execute(PerlInterpreter * my_perl, char *input_code, c
 	return error;
 }
 
+#define HACK_CLEAN_CODE "foreach my $kl(keys %main::) {undef($$kl) if (defined($$kl) && ($kl =~ /^\\w+[\\w\\d_]+$/))}"
+
 static void destroy_perl(PerlInterpreter ** to_destroy)
 {
+	Perl_safe_eval(*to_destroy, HACK_CLEAN_CODE);
 	perl_destruct(*to_destroy);
 	perl_free(*to_destroy);
 	*to_destroy = NULL;
@@ -189,14 +192,20 @@ 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];
+	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"
@@ -204,8 +213,6 @@ static void perl_function(switch_core_session_t *session, char *data)
 					"$SWITCH_ENV{UUID} = \"%s\";\n" "$session = new freeswitch::Session(\"%s\")", SWITCH_GLOBAL_dirs.base_dir, uuid, uuid);
 
 	perl_parse_and_execute(my_perl, data, code);
-	Perl_safe_eval(my_perl, "undef $session;");
-	Perl_safe_eval(my_perl, "undef (*);");
 	destroy_perl(&my_perl);
 }
 
@@ -264,12 +271,6 @@ static void *SWITCH_THREAD_FUNC perl_thread_run(switch_thread_t *thread, void *o
 		perl_parse_and_execute(my_perl, cmd, NULL);
 	}
 
-	if (uuid) {
-		switch_snprintf(code, sizeof(code), "undef $session;", uuid);
-		Perl_safe_eval(my_perl, code);
-	}
-
-	Perl_safe_eval(my_perl, "undef(*);");
 	destroy_perl(&my_perl);
 
 	switch_safe_free(cmd);
@@ -277,7 +278,7 @@ static void *SWITCH_THREAD_FUNC perl_thread_run(switch_thread_t *thread, void *o
 	if (po->d) {
 		free(po);
 	}
-
+	
 	return NULL;
 }