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,71 +224,79 @@ 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 (itype) {
+	switch_mutex_lock(callback_mutex);
-	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))) {
+	if (!destroying) {
-				abort();
+		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;
 
-			str[0] = dtmf->digit;
+				if (!(hash = get_hv("__dtmf", TRUE))) {
-			this_sv = newSV(strlen(str) + 1);
+					abort();
-			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);
-
-			code = switch_mprintf("eval { $__RV = &%s($%s, 'dtmf', \\%%__dtmf, %s);};", cb_function, suuid, switch_str_nil(cb_arg));
-			Perl_eval_pv(my_perl, code, FALSE);
-			free(code);
-
-			return process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
-		}
-		break;
-	case SWITCH_INPUT_TYPE_EVENT:
-		{
-			switch_event_t *event = (switch_event_t *) input;
-			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 *p;
-
-			switch_uuid_get(&uuid);
-			switch_uuid_format(uuid_str, &uuid);
-
-			switch_snprintf(var_name, sizeof(var_name), "main::__event_%s", uuid_str);
-			for(p = var_name; p && *p; p++) {
-				if (*p == '-') {
-					*p = '_';
 				}
+
+				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);
+
+				code = switch_mprintf("eval { $__RV = &%s($%s, 'dtmf', \\%%__dtmf, %s);};", cb_function, suuid, switch_str_nil(cb_arg));
+				Perl_eval_pv(my_perl, code, FALSE);
+				free(code);
+
+				status = process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
 			}
+			break;
+		case SWITCH_INPUT_TYPE_EVENT:
+			{
+				switch_event_t *event = (switch_event_t *) input;
+				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 *p;
 
-			mod_perl_conjure_event(my_perl, event, var_name);
+				switch_uuid_get(&uuid);
-			code = switch_mprintf("eval {$__RV = &%s($%s, 'event', $%s, '%s');};$%s = undef;",
+				switch_uuid_format(uuid_str, &uuid);
-								  cb_function, suuid, var_name, switch_str_nil(cb_arg), var_name);
-			Perl_eval_pv(my_perl, code, FALSE);
-			free(code);
 
-			return process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
+				switch_snprintf(var_name, sizeof(var_name), "__event_%s", uuid_str);
+				for(p = var_name; p && *p; p++) {
+					if (*p == '-') {
+						*p = '_';
+					}
+				}
+
+				mod_perl_conjure_event(my_perl, event, var_name);
+				code = switch_mprintf("eval {$__RV = &%s($%s, 'event', $%s, '%s');};$%s = undef;",
+									  cb_function, suuid, var_name, switch_str_nil(cb_arg), var_name);
+				Perl_eval_pv(my_perl, code, FALSE);
+				free(code);
+
+				status = process_callback_result(SvPV(get_sv("__RV", TRUE), n_a));
+			}
+			break;
 		}
-		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)
 {