FS-11259: [mod_perl] mod_perl tweaks #resolve

This commit is contained in:
Anthony Minessale 2018-07-19 02:59:40 +00:00 committed by Muteesa Fred
parent 9d0ad92d10
commit 3323809985
3 changed files with 78 additions and 55 deletions

View File

@ -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) {
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;
switch_mutex_lock(callback_mutex);
if (!(hash = get_hv("__dtmf", TRUE))) {
abort();
}
if (!destroying) {
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;
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);
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 = '_';
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);
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);
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);
switch_uuid_get(&uuid);
switch_uuid_format(uuid_str, &uuid);
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;
}

View File

@ -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;

View File

@ -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)
{