FS-11259: [mod_perl] mod_perl tweaks #resolve

src/mod/languages/mod_perl/freeswitch_perl.cpp

@@ -16,6 +16,8 @@ Session::Session():CoreSession()
 Session::Session(char *uuid, CoreSession *a_leg):CoreSession(uuid, a_leg)
 {
 	init_me();
+	switch_mutex_init(&callback_mutex, SWITCH_MUTEX_NESTED, switch_core_session_get_pool(session));
+	
 	if (session && allocated) {
 		suuid = switch_core_session_sprintf(session, "main::uuid_%s\n", switch_core_session_get_uuid(session));
 		for (char *p = suuid; p && *p; p++) {
@@ -32,6 +34,8 @@ Session::Session(char *uuid, CoreSession *a_leg):CoreSession(uuid, a_leg)
 Session::Session(switch_core_session_t *new_session):CoreSession(new_session)
 {
 	init_me();
+	switch_mutex_init(&callback_mutex, SWITCH_MUTEX_NESTED, switch_core_session_get_pool(session));
+
 	if (session) {
 		suuid = switch_core_session_sprintf(session, "main::uuid_%s\n", switch_core_session_get_uuid(session));
 		for (char *p = suuid; p && *p; p++) {
@@ -52,6 +56,10 @@ void Session::destroy(void)
 		return;
 	}
 
+	switch_mutex_lock(callback_mutex);
+	destroying = 1;
+	switch_mutex_unlock(callback_mutex);
+
 	if (session) {
 		if (!channel) {
 			channel = switch_core_session_get_channel(session);
@@ -216,10 +224,15 @@ void Session::setInputCallback(char *cbfunc, char *funcargs)
 
 switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t itype)
 {
+	switch_status_t status = SWITCH_STATUS_SUCCESS;
+	
 	if (!getPERL()) {
 		return SWITCH_STATUS_FALSE;;
 	}
 
+	switch_mutex_lock(callback_mutex);
+
+	if (!destroying) {
 		switch (itype) {
 		case SWITCH_INPUT_TYPE_DTMF:
 			{
@@ -248,7 +261,7 @@ switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t ityp
 				Perl_eval_pv(my_perl, code, FALSE);
 				free(code);
 
-			return process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
+				status = process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
 			}
 			break;
 		case SWITCH_INPUT_TYPE_EVENT:
@@ -257,14 +270,14 @@ switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t ityp
 				int arg_count = 2;
 				char *code;
 				switch_uuid_t uuid;
-			char uuid_str[SWITCH_UUID_FORMATTED_LENGTH + 1];
-			char var_name[SWITCH_UUID_FORMATTED_LENGTH + 25];
+				char uuid_str[SWITCH_UUID_FORMATTED_LENGTH + 1] = "";
+				char var_name[SWITCH_UUID_FORMATTED_LENGTH + 25] = "";
 				char *p;
 
 				switch_uuid_get(&uuid);
 				switch_uuid_format(uuid_str, &uuid);
 
-			switch_snprintf(var_name, sizeof(var_name), "main::__event_%s", uuid_str);
+				switch_snprintf(var_name, sizeof(var_name), "__event_%s", uuid_str);
 				for(p = var_name; p && *p; p++) {
 					if (*p == '-') {
 						*p = '_';
@@ -277,10 +290,13 @@ switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t ityp
 				Perl_eval_pv(my_perl, code, FALSE);
 				free(code);
 
-			return process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
+				status = process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
 			}
 			break;
 		}
+	}
 	
-	return SWITCH_STATUS_SUCCESS;
+	switch_mutex_unlock(callback_mutex);
+		
+	return status;
 }

src/mod/languages/mod_perl/freeswitch_perl.h

@@ -41,6 +41,9 @@ namespace PERL {
 		void unsetInputCallback(void);
 		void setHangupHook(char *func, char *arg = NULL);
 		bool ready();
+		switch_mutex_t *callback_mutex;
+		int destroying = 0;
+		int event_idx = 0;
 		char *suuid;
 		char *cb_function;
 		char *cb_arg;

src/mod/languages/mod_perl/mod_perl.c

@@ -143,7 +143,11 @@ static int perl_parse_and_execute(PerlInterpreter * my_perl, char *input_code, c
 	return error;
 }
 
+#ifdef DEBUG_PERL
+#define HACK_CLEAN_CODE "eval{foreach my $kl(keys %main::) {eval{print qq'DEBUG: ' . $kl . '/' . $$kl . '/' . $$$kl . qq'\n';undef($$kl);} if (defined($$kl) && ($kl =~ /^\\w+[\\w\\d_]+$/))}}"
+#else
 #define HACK_CLEAN_CODE "eval{foreach my $kl(keys %main::) {eval{undef($$kl);} if (defined($$kl) && ($kl =~ /^\\w+[\\w\\d_]+$/))}}"
+#endif
 
 static void destroy_perl(PerlInterpreter ** to_destroy)
 {