From 8027cb8ee87c22615939076db23cf3a457bdd211 Mon Sep 17 00:00:00 2001 From: Anthony Minessale Date: Fri, 25 Apr 2008 22:12:01 +0000 Subject: [PATCH] return of mod_perl git-svn-id: http://svn.freeswitch.org/svn/freeswitch/trunk@8198 d0543943-73ff-0310-b7d9-9358b9ac24b2 --- conf/autoload_configs/perl.conf.xml | 6 + src/mod/languages/mod_perl/Makefile | 34 + src/mod/languages/mod_perl/compiler.opts | 1 + src/mod/languages/mod_perl/compiler.opts.in | 1 + src/mod/languages/mod_perl/freeswitch.i | 30 + src/mod/languages/mod_perl/freeswitch.pm | 319 + .../languages/mod_perl/freeswitch_perl.cpp | 85 + src/mod/languages/mod_perl/freeswitch_perl.h | 78 + src/mod/languages/mod_perl/mod_perl.c | 431 ++ src/mod/languages/mod_perl/mod_perl.vcproj | 69 + src/mod/languages/mod_perl/mod_perl_wrap.cpp | 5924 +++++++++++++++++ src/mod/languages/mod_perl/perlibs.h | 1 + src/mod/languages/mod_perl/perlibs.h.in | 1 + src/mod/languages/mod_perl/perlxsi.c | 18 + 14 files changed, 6998 insertions(+) create mode 100644 conf/autoload_configs/perl.conf.xml create mode 100644 src/mod/languages/mod_perl/Makefile create mode 100644 src/mod/languages/mod_perl/compiler.opts create mode 100644 src/mod/languages/mod_perl/compiler.opts.in create mode 100644 src/mod/languages/mod_perl/freeswitch.i create mode 100644 src/mod/languages/mod_perl/freeswitch.pm create mode 100644 src/mod/languages/mod_perl/freeswitch_perl.cpp create mode 100644 src/mod/languages/mod_perl/freeswitch_perl.h create mode 100644 src/mod/languages/mod_perl/mod_perl.c create mode 100644 src/mod/languages/mod_perl/mod_perl.vcproj create mode 100644 src/mod/languages/mod_perl/mod_perl_wrap.cpp create mode 100644 src/mod/languages/mod_perl/perlibs.h create mode 100644 src/mod/languages/mod_perl/perlibs.h.in create mode 100644 src/mod/languages/mod_perl/perlxsi.c diff --git a/conf/autoload_configs/perl.conf.xml b/conf/autoload_configs/perl.conf.xml new file mode 100644 index 0000000000..83732890c6 --- /dev/null +++ b/conf/autoload_configs/perl.conf.xml @@ -0,0 +1,6 @@ + + + + + + diff --git a/src/mod/languages/mod_perl/Makefile b/src/mod/languages/mod_perl/Makefile new file mode 100644 index 0000000000..3d33b7c143 --- /dev/null +++ b/src/mod/languages/mod_perl/Makefile @@ -0,0 +1,34 @@ +BASE=../../../.. +PERL = `which perl` +PERL_LIBDIR =-L$(shell perl -MConfig -e 'print $$Config{archlib}')/CORE +PERL_LIBS =$(shell perl -MConfig -e 'print $$Config{libs}') +LOCAL_CFLAGS= -w -DMULTIPLICITY $(shell $(PERL) -MExtUtils::Embed -e ccopts) -DEMBED_PERL +LOCAL_LDFLAGS=$(shell $(PERL) -MExtUtils::Embed -e ldopts) $(shell $(PERL) -MConfig -e 'print $$Config{libs}') +LOCAL_OBJS=freeswitch_perl.o mod_perl_wrap.o perlxsi.o +VERBOSE=1 + +include $(BASE)/build/modmake.rules + +swigclean: clean + rm mod_perl_wrap.* + +mod_perl_wrap.cpp: $(TOLUA_A) + swig -static -shadow -perl5 -c++ -DMULTIPLICITY -I../../../../src/include -o mod_perl_wrap.cpp freeswitch.i + +freeswitch.$(DYNAMIC_LIB_EXTEN): $(LOCAL_OBJS) $(LOCAL_LIBADD) + $(LINK) $(SOLINK) -o freeswitch.$(DYNAMIC_LIB_EXTEN) $(LOCAL_OBJS) $(LOCAL_LIBADD) $(LDFLAGS) + +local_all: freeswitch.$(DYNAMIC_LIB_EXTEN) + +.perlok: + @(${PERL} -V | grep -i usemultiplicity=define >/dev/null && echo Phew, You have the right perl.) \ + || ((echo Sorry, you need to compile perl with threads and multiplicity.&& exit 1)) + @touch .perlok + +local_clean: + rm -fr *~ .perlok freeswitch.$(DYNAMIC_LIB_EXTEN) + +depend_install: + mkdir -p $(PREFIX)/perl + $(LTINSTALL) freeswitch.$(DYNAMIC_LIB_EXTEN) freeswitch.pm $(PREFIX)/perl + if [ ! -f $(PREFIX)/perl/freeswitch.pm ] ; then $(LTINSTALL) freeswitch.pm $(PREFIX)/perl ; fi diff --git a/src/mod/languages/mod_perl/compiler.opts b/src/mod/languages/mod_perl/compiler.opts new file mode 100644 index 0000000000..e5f81c4039 --- /dev/null +++ b/src/mod/languages/mod_perl/compiler.opts @@ -0,0 +1 @@ +/IC:\perl\lib\CORE \ No newline at end of file diff --git a/src/mod/languages/mod_perl/compiler.opts.in b/src/mod/languages/mod_perl/compiler.opts.in new file mode 100644 index 0000000000..61b705b080 --- /dev/null +++ b/src/mod/languages/mod_perl/compiler.opts.in @@ -0,0 +1 @@ +/I@PERL_INCLUDE@ \ No newline at end of file diff --git a/src/mod/languages/mod_perl/freeswitch.i b/src/mod/languages/mod_perl/freeswitch.i new file mode 100644 index 0000000000..62f7bf00b8 --- /dev/null +++ b/src/mod/languages/mod_perl/freeswitch.i @@ -0,0 +1,30 @@ +%module freeswitch +//%include "cstring.i" + +/** + * tell swig to treat these variables as mutable so they + * can be used to return values. + * See http://www.swig.org/Doc1.3/Library.html + */ +//%cstring_bounded_mutable(char *dtmf_buf, 128); +//%cstring_bounded_mutable(char *terminator, 8); + + +/** insert the following includes into generated code so it compiles */ +%{ +#include "switch_cpp.h" +#include "freeswitch_perl.h" +%} + + +%ignore SwitchToMempool; + +/** + * tell swig to grok everything defined in these header files and + * build all sorts of c wrappers and lua shadows of the c wrappers. + */ +%include switch_cpp.h +%include freeswitch_perl.h + + + diff --git a/src/mod/languages/mod_perl/freeswitch.pm b/src/mod/languages/mod_perl/freeswitch.pm new file mode 100644 index 0000000000..07972ae753 --- /dev/null +++ b/src/mod/languages/mod_perl/freeswitch.pm @@ -0,0 +1,319 @@ +# This file was automatically generated by SWIG (http://www.swig.org). +# Version 1.3.35 +# +# Don't modify this file, modify the SWIG interface instead. + +package freeswitch; +require Exporter; +@ISA = qw(Exporter); +package freeswitchc; +boot_freeswitch(); +package freeswitch; +@EXPORT = qw( ); + +# ---------- BASE METHODS ------------- + +package freeswitch; + +sub TIEHASH { + my ($classname,$obj) = @_; + return bless $obj, $classname; +} + +sub CLEAR { } + +sub FIRSTKEY { } + +sub NEXTKEY { } + +sub FETCH { + my ($self,$field) = @_; + my $member_func = "swig_${field}_get"; + $self->$member_func(); +} + +sub STORE { + my ($self,$field,$newval) = @_; + my $member_func = "swig_${field}_set"; + $self->$member_func($newval); +} + +sub this { + my $ptr = shift; + return tied(%$ptr); +} + + +# ------- FUNCTION WRAPPERS -------- + +package freeswitch; + +*console_log = *freeswitchc::console_log; +*console_clean_log = *freeswitchc::console_clean_log; +*api_execute = *freeswitchc::api_execute; +*api_reply_delete = *freeswitchc::api_reply_delete; +*process_callback_result = *freeswitchc::process_callback_result; +*bridge = *freeswitchc::bridge; +*hanguphook = *freeswitchc::hanguphook; +*dtmf_callback = *freeswitchc::dtmf_callback; + +############# Class : freeswitch::input_callback_state_t ############## + +package freeswitch::input_callback_state_t; +use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS); +@ISA = qw( freeswitch ); +%OWNER = (); +%ITERATORS = (); +*swig_function_get = *freeswitchc::input_callback_state_t_function_get; +*swig_function_set = *freeswitchc::input_callback_state_t_function_set; +*swig_threadState_get = *freeswitchc::input_callback_state_t_threadState_get; +*swig_threadState_set = *freeswitchc::input_callback_state_t_threadState_set; +*swig_extra_get = *freeswitchc::input_callback_state_t_extra_get; +*swig_extra_set = *freeswitchc::input_callback_state_t_extra_set; +*swig_funcargs_get = *freeswitchc::input_callback_state_t_funcargs_get; +*swig_funcargs_set = *freeswitchc::input_callback_state_t_funcargs_set; +sub new { + my $pkg = shift; + my $self = freeswitchc::new_input_callback_state_t(@_); + bless $self, $pkg if defined($self); +} + +sub DESTROY { + return unless $_[0]->isa('HASH'); + my $self = tied(%{$_[0]}); + return unless defined $self; + delete $ITERATORS{$self}; + if (exists $OWNER{$self}) { + freeswitchc::delete_input_callback_state_t($self); + delete $OWNER{$self}; + } +} + +sub DISOWN { + my $self = shift; + my $ptr = tied(%$self); + delete $OWNER{$ptr}; +} + +sub ACQUIRE { + my $self = shift; + my $ptr = tied(%$self); + $OWNER{$ptr} = 1; +} + + +############# Class : freeswitch::Stream ############## + +package freeswitch::Stream; +use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS); +@ISA = qw( freeswitch ); +%OWNER = (); +%ITERATORS = (); +sub new { + my $pkg = shift; + my $self = freeswitchc::new_Stream(@_); + bless $self, $pkg if defined($self); +} + +sub DESTROY { + return unless $_[0]->isa('HASH'); + my $self = tied(%{$_[0]}); + return unless defined $self; + delete $ITERATORS{$self}; + if (exists $OWNER{$self}) { + freeswitchc::delete_Stream($self); + delete $OWNER{$self}; + } +} + +*write = *freeswitchc::Stream_write; +*get_data = *freeswitchc::Stream_get_data; +sub DISOWN { + my $self = shift; + my $ptr = tied(%$self); + delete $OWNER{$ptr}; +} + +sub ACQUIRE { + my $self = shift; + my $ptr = tied(%$self); + $OWNER{$ptr} = 1; +} + + +############# Class : freeswitch::Event ############## + +package freeswitch::Event; +use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS); +@ISA = qw( freeswitch ); +%OWNER = (); +%ITERATORS = (); +sub new { + my $pkg = shift; + my $self = freeswitchc::new_Event(@_); + bless $self, $pkg if defined($self); +} + +sub DESTROY { + return unless $_[0]->isa('HASH'); + my $self = tied(%{$_[0]}); + return unless defined $self; + delete $ITERATORS{$self}; + if (exists $OWNER{$self}) { + freeswitchc::delete_Event($self); + delete $OWNER{$self}; + } +} + +*set_priority = *freeswitchc::Event_set_priority; +*get_header = *freeswitchc::Event_get_header; +*get_body = *freeswitchc::Event_get_body; +*add_body = *freeswitchc::Event_add_body; +*add_header = *freeswitchc::Event_add_header; +*del_header = *freeswitchc::Event_del_header; +*fire = *freeswitchc::Event_fire; +sub DISOWN { + my $self = shift; + my $ptr = tied(%$self); + delete $OWNER{$ptr}; +} + +sub ACQUIRE { + my $self = shift; + my $ptr = tied(%$self); + $OWNER{$ptr} = 1; +} + + +############# Class : freeswitch::CoreSession ############## + +package freeswitch::CoreSession; +use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS); +@ISA = qw( freeswitch ); +%OWNER = (); +%ITERATORS = (); +sub DESTROY { + return unless $_[0]->isa('HASH'); + my $self = tied(%{$_[0]}); + return unless defined $self; + delete $ITERATORS{$self}; + if (exists $OWNER{$self}) { + freeswitchc::delete_CoreSession($self); + delete $OWNER{$self}; + } +} + +*swig_session_get = *freeswitchc::CoreSession_session_get; +*swig_session_set = *freeswitchc::CoreSession_session_set; +*swig_channel_get = *freeswitchc::CoreSession_channel_get; +*swig_channel_set = *freeswitchc::CoreSession_channel_set; +*swig_flags_get = *freeswitchc::CoreSession_flags_get; +*swig_flags_set = *freeswitchc::CoreSession_flags_set; +*swig_allocated_get = *freeswitchc::CoreSession_allocated_get; +*swig_allocated_set = *freeswitchc::CoreSession_allocated_set; +*swig_cb_state_get = *freeswitchc::CoreSession_cb_state_get; +*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; +*answer = *freeswitchc::CoreSession_answer; +*preAnswer = *freeswitchc::CoreSession_preAnswer; +*hangup = *freeswitchc::CoreSession_hangup; +*setVariable = *freeswitchc::CoreSession_setVariable; +*getVariable = *freeswitchc::CoreSession_getVariable; +*recordFile = *freeswitchc::CoreSession_recordFile; +*setCallerData = *freeswitchc::CoreSession_setCallerData; +*originate = *freeswitchc::CoreSession_originate; +*setDTMFCallback = *freeswitchc::CoreSession_setDTMFCallback; +*speak = *freeswitchc::CoreSession_speak; +*set_tts_parms = *freeswitchc::CoreSession_set_tts_parms; +*collectDigits = *freeswitchc::CoreSession_collectDigits; +*getDigits = *freeswitchc::CoreSession_getDigits; +*transfer = *freeswitchc::CoreSession_transfer; +*playAndGetDigits = *freeswitchc::CoreSession_playAndGetDigits; +*streamFile = *freeswitchc::CoreSession_streamFile; +*flushEvents = *freeswitchc::CoreSession_flushEvents; +*flushDigits = *freeswitchc::CoreSession_flushDigits; +*setAutoHangup = *freeswitchc::CoreSession_setAutoHangup; +*setHangupHook = *freeswitchc::CoreSession_setHangupHook; +*ready = *freeswitchc::CoreSession_ready; +*execute = *freeswitchc::CoreSession_execute; +*begin_allow_threads = *freeswitchc::CoreSession_begin_allow_threads; +*end_allow_threads = *freeswitchc::CoreSession_end_allow_threads; +*get_uuid = *freeswitchc::CoreSession_get_uuid; +*get_cb_args = *freeswitchc::CoreSession_get_cb_args; +*check_hangup_hook = *freeswitchc::CoreSession_check_hangup_hook; +*run_dtmf_callback = *freeswitchc::CoreSession_run_dtmf_callback; +sub DISOWN { + my $self = shift; + my $ptr = tied(%$self); + delete $OWNER{$ptr}; +} + +sub ACQUIRE { + my $self = shift; + my $ptr = tied(%$self); + $OWNER{$ptr} = 1; +} + + +############# Class : freeswitch::Session ############## + +package freeswitch::Session; +use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS); +@ISA = qw( freeswitch::CoreSession freeswitch ); +%OWNER = (); +%ITERATORS = (); +sub new { + my $pkg = shift; + my $self = freeswitchc::new_Session(@_); + bless $self, $pkg if defined($self); +} + +sub DESTROY { + return unless $_[0]->isa('HASH'); + my $self = tied(%{$_[0]}); + return unless defined $self; + delete $ITERATORS{$self}; + if (exists $OWNER{$self}) { + freeswitchc::delete_Session($self); + delete $OWNER{$self}; + } +} + +*begin_allow_threads = *freeswitchc::Session_begin_allow_threads; +*end_allow_threads = *freeswitchc::Session_end_allow_threads; +*check_hangup_hook = *freeswitchc::Session_check_hangup_hook; +*run_dtmf_callback = *freeswitchc::Session_run_dtmf_callback; +*swig_session_get = *freeswitchc::Session_session_get; +*swig_session_set = *freeswitchc::Session_session_set; +*swig_channel_get = *freeswitchc::Session_channel_get; +*swig_channel_set = *freeswitchc::Session_channel_set; +*swig_flags_get = *freeswitchc::Session_flags_get; +*swig_flags_set = *freeswitchc::Session_flags_set; +*swig_allocated_get = *freeswitchc::Session_allocated_get; +*swig_allocated_set = *freeswitchc::Session_allocated_set; +*swig_cb_state_get = *freeswitchc::Session_cb_state_get; +*swig_cb_state_set = *freeswitchc::Session_cb_state_set; +*swig_hook_state_get = *freeswitchc::Session_hook_state_get; +*swig_hook_state_set = *freeswitchc::Session_hook_state_set; +sub DISOWN { + my $self = shift; + my $ptr = tied(%$self); + delete $OWNER{$ptr}; +} + +sub ACQUIRE { + my $self = shift; + my $ptr = tied(%$self); + $OWNER{$ptr} = 1; +} + + +# ------- VARIABLE STUBS -------- + +package freeswitch; + +*S_HUP = *freeswitchc::S_HUP; +*S_FREE = *freeswitchc::S_FREE; +*S_RDLOCK = *freeswitchc::S_RDLOCK; +1; diff --git a/src/mod/languages/mod_perl/freeswitch_perl.cpp b/src/mod/languages/mod_perl/freeswitch_perl.cpp new file mode 100644 index 0000000000..12fff1ab92 --- /dev/null +++ b/src/mod/languages/mod_perl/freeswitch_perl.cpp @@ -0,0 +1,85 @@ +#include "freeswitch_perl.h" + +Session::Session() : CoreSession() +{ + +} + +Session::Session(char *uuid) : CoreSession(uuid) +{ + +} + +Session::Session(switch_core_session_t *new_session) : CoreSession(new_session) +{ + +} + +Session::~Session() +{ + +} + + +bool Session::begin_allow_threads() +{ + return true; +} + +bool Session::end_allow_threads() +{ + return true; +} + +void Session::check_hangup_hook() +{ +} + +switch_status_t Session::run_dtmf_callback(void *input, switch_input_type_t itype) +{ + return SWITCH_STATUS_FALSE; +} + + +#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 diff --git a/src/mod/languages/mod_perl/freeswitch_perl.h b/src/mod/languages/mod_perl/freeswitch_perl.h new file mode 100644 index 0000000000..682051acf4 --- /dev/null +++ b/src/mod/languages/mod_perl/freeswitch_perl.h @@ -0,0 +1,78 @@ +#ifndef FREESWITCH_PYTHON_H +#define FREESWITCH_PYTHON_H + +#include + +void console_log(char *level_str, char *msg); +void console_clean_log(char *msg); +char *api_execute(char *cmd, char *arg); +void api_reply_delete(char *reply); + + +class Session : public CoreSession { + private: + 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); + + switch_core_session_t *session; + switch_channel_t *channel; + unsigned int flags; + int allocated; + input_callback_state cb_state; // callback state, always pointed to by the buf + // field in this->args + switch_channel_state_t hook_state; // store hookstate for on_hangup callback + +#if 0 + + int answer(); + int preAnswer(); + virtual void hangup(char *cause); + void setVariable(char *var, char *val); + const char *getVariable(char *var); + int recordFile(char *file_name, int max_len=0, int silence_threshold=0, int silence_secs=0); + void setCallerData(char *var, char *val); + int originate(CoreSession *a_leg_session, char *dest, int timeout=60); + void setDTMFCallback(void *cbfunc, char *funcargs); + int speak(char *text); + void set_tts_parms(char *tts_name, char *voice_name); + int collectDigits(int timeout); + int getDigits(char *dtmf_buf, + switch_size_t buflen, + switch_size_t maxdigits, + char *terminators, + char *terminator, + int timeout); + + int transfer(char *extensions, char *dialplan, char *context); + int 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 streamFile(char *file, int starting_sample_count=0); + int flushEvents(); + int flushDigits(); + int setAutoHangup(bool val); + void setHangupHook(void *hangup_func); + bool ready(); + void execute(char *app, char *data); + char* get_uuid(); + const switch_input_args_t& get_cb_args(); +#endif + +}; + +#endif diff --git a/src/mod/languages/mod_perl/mod_perl.c b/src/mod/languages/mod_perl/mod_perl.c new file mode 100644 index 0000000000..f55c1346bf --- /dev/null +++ b/src/mod/languages/mod_perl/mod_perl.c @@ -0,0 +1,431 @@ +/* + * FreeSWITCH Modular Media Switching Software Library / Soft-Switch Application + * Copyright (C) 2005/2006, Anthony Minessale II + * + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is FreeSWITCH Modular Media Switching Software Library / Soft-Switch Application + * + * The Initial Developer of the Original Code is + * Anthony Minessale II + * Portions created by the Initial Developer are Copyright (C) + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * Anthony Minessale II + * + * + * mod_perl.c -- Perl + * + */ +#ifdef __ICC +#pragma warning (disable:1419) +#endif +#ifdef _MSC_VER +#include +#pragma comment(lib, PERL_LIB) +#endif + +#include +#include +#include +static char *embedding[] = { "", "-e", "" }; +EXTERN_C void xs_init(pTHX); + +SWITCH_MODULE_LOAD_FUNCTION(mod_perl_load); +SWITCH_MODULE_SHUTDOWN_FUNCTION(mod_perl_shutdown); +SWITCH_MODULE_DEFINITION(mod_perl, mod_perl_load, mod_perl_shutdown, NULL); + + + +static STRLEN n_a; + +static struct { + PerlInterpreter *my_perl; + switch_memory_pool_t *pool; + char *xml_handler; +} globals; + + +static void Perl_safe_eval(PerlInterpreter *my_perl, const char *string, int tf) +{ + char *st = switch_mprintf("eval { %s }; $__ERR = $@", string); + char *err = NULL; + Perl_eval_pv(my_perl, st, tf); + + if ((err = SvPV(get_sv("__ERR", FALSE), n_a)) && !switch_strlen_zero(err)) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "%s\n", err); + } + + switch_safe_free(st); +} + +static void destroy_perl(PerlInterpreter ** to_destroy) +{ + perl_destruct(*to_destroy); + perl_free(*to_destroy); + *to_destroy = NULL; +} + +static PerlInterpreter *clone_perl(void) +{ + PerlInterpreter *my_perl = perl_clone(globals.my_perl, CLONEf_COPY_STACKS | CLONEf_KEEP_PTR_TABLE); + PERL_SET_CONTEXT(my_perl); + return my_perl; +} + +static perl_parse_and_execute (PerlInterpreter *my_perl, char *input_code, char *setup_code) +{ + int error = 0; + + + 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, TRUE); + Perl_safe_eval(my_perl, buff, TRUE); + } else { + int argc = 0; + char *argv[128] = { 0 }; + argv[0] = "FreeSWITCH"; + argc++; + + argc += switch_separate_string(input_code, ' ', &argv[1], (sizeof(argv) / sizeof(argv[0])) - 1); + perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); + if (setup_code) Perl_safe_eval(my_perl, setup_code, TRUE); + perl_run(my_perl); + } +} + + + +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]; + switch_snprintf(code, sizeof(code), + "use lib '%s/perl';\n" + "use freeswitch;\n" + "$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;", TRUE); + Perl_safe_eval(my_perl, "undef (*);", TRUE); + 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"); + } + return SWITCH_STATUS_SUCCESS; +} + +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]; + + switch_snprintf(code, sizeof(code), + "use lib '%s/perl';\n" + "use freeswitch;\n" + , + SWITCH_GLOBAL_dirs.base_dir + ); + + perl_parse_and_execute(my_perl, input_code, code); + + if (input_code) { + free(input_code); + } + + Perl_safe_eval(my_perl, "undef(*);", TRUE); + destroy_perl(&my_perl); + + return NULL; +} + +int perl_thread(const char *text) +{ + switch_thread_t *thread; + switch_threadattr_t *thd_attr = NULL; + + 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); + + return 0; +} + +SWITCH_STANDARD_API(perlrun_api_function) { + perl_thread(cmd); + stream->write_function(stream, "+OK\n"); + return SWITCH_STATUS_SUCCESS; +} + +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, TRUE); + + if (uuid) { + switch_snprintf(code, sizeof(code), "$session = new freeswitch::Session(\"%s\")", uuid); + Perl_safe_eval(my_perl, code, TRUE); + } + + if (cmd) { + Perl_safe_eval(my_perl, cmd, TRUE); + } + + 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, TRUE); + } + + Perl_safe_eval(my_perl, "undef(*);", TRUE); + destroy_perl(&my_perl); + + + return SWITCH_STATUS_SUCCESS; +} + + +static switch_xml_t perl_fetch(const char *section, + const char *tag_name, + const char *key_name, + const char *key_value, + switch_event_t *params, + void *user_data) +{ + + char *argv[128] = { 0 }; + int argc = 0; + switch_xml_t xml = NULL; + + if (!switch_strlen_zero(globals.xml_handler)) { + PerlInterpreter *my_perl = clone_perl(); + HV *hash; + char *str; + switch_event_header_t *hp; + SV *this; + char code[1024] = ""; + + argv[argc++] = "FreeSWITCH"; + argv[argc++] = globals.xml_handler; + + PERL_SET_CONTEXT(my_perl); + + if (perl_parse(my_perl, xs_init, argc, argv, (char **)NULL)) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "Error Parsing Result!\n"); + return NULL; + } + + if (!(hash = get_hv("XML_REQUEST", TRUE))) { + abort(); + } + + if (switch_strlen_zero(section)) { + section = ""; + } + + this = newSV(strlen(section)+1); + sv_setpv(this, section); + hv_store(hash, "section", 7, this, 0); + + + if (switch_strlen_zero(tag_name)) { + tag_name = ""; + } + + this = newSV(strlen(tag_name)+1); + sv_setpv(this, tag_name); + hv_store(hash, "tag_name", 8, this, 0); + + if (switch_strlen_zero(key_name)) { + key_name = ""; + } + + this = newSV(strlen(key_name)+1); + sv_setpv(this, key_name); + hv_store(hash, "key_name", 8, this, 0); + + + if (switch_strlen_zero(key_value)) { + key_value = ""; + } + + this = newSV(strlen(key_value)+1); + sv_setpv(this, key_value); + hv_store(hash, "key_value", 9, this, 0); + + if (!(hash = get_hv("XML_DATA", TRUE))) { + abort(); + } + + + if (params) { + for (hp = params->headers; hp; hp = hp->next) { + this = newSV(strlen(hp->value)+1); + sv_setpv(this, hp->value); + hv_store(hash, hp->name, strlen(hp->name), this, 0); + } + } + + switch_snprintf(code, sizeof(code), + "use lib '%s/perl';\n" + "use freeswitch;\n" + , + SWITCH_GLOBAL_dirs.base_dir + ); + Perl_safe_eval(my_perl, code, TRUE); + + perl_run(my_perl); + str = SvPV(get_sv("XML_STRING", FALSE), n_a); + + if (str) { + if (switch_strlen_zero(str)) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "No Result\n"); + } else if (!(xml = switch_xml_parse_str(str, strlen(str)))) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "Error Parsing XML Result!\n"); + } + } + + destroy_perl(&my_perl); + } + + return xml; + +} + +static switch_status_t do_config(void) +{ + + char *cf = "perl.conf"; + switch_xml_t cfg, xml, settings, param; + + + if (!(xml = switch_xml_open_cfg(cf, &cfg, NULL))) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "open of %s failed\n", cf); + return SWITCH_STATUS_TERM; + } + + if ((settings = switch_xml_child(cfg, "settings"))) { + for (param = switch_xml_child(settings, "param"); param; param = param->next) { + char *var = (char *) switch_xml_attr_soft(param, "name"); + char *val = (char *) switch_xml_attr_soft(param, "value"); + + if (!strcmp(var, "xml-handler-script")) { + globals.xml_handler = switch_core_strdup(globals.pool, val); + } else if (!strcmp(var, "xml-handler-bindings")) { + if (!switch_strlen_zero(globals.xml_handler)) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_INFO, "binding '%s' to '%s'\n", globals.xml_handler, var); + switch_xml_bind_search_function(perl_fetch, switch_xml_parse_section_string(val), NULL); + } + } + } + } + + + switch_xml_free(xml); + + return SWITCH_STATUS_SUCCESS; +} + + +SWITCH_MODULE_LOAD_FUNCTION(mod_perl_load) +{ + switch_application_interface_t *app_interface; + PerlInterpreter *my_perl; + char code[1024]; + switch_api_interface_t *api_interface; + + globals.pool = pool; + + if (!(my_perl = perl_alloc())) { + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "Could not allocate perl intrepreter\n"); + return SWITCH_STATUS_MEMERR; + } + switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_INFO, "Allocated perl intrepreter.\n"); + + + perl_construct(my_perl); + perl_parse(my_perl, xs_init, 3, embedding, NULL); + perl_run(my_perl); + globals.my_perl = my_perl; + + //switch_snprintf(code, sizeof(code), "use lib '%s/perl';use freeswitch\n", SWITCH_GLOBAL_dirs.base_dir); + + + + /* connect my internal structure to the blank pointer passed to me */ + *module_interface = switch_loadable_module_create_module_interface(pool, modname); + SWITCH_ADD_APP(app_interface, "perl", NULL, NULL, perl_function, NULL, SAF_NONE); + SWITCH_ADD_API(api_interface, "perlrun", "run a script", perlrun_api_function, "