2006-03-03 16:57:21 +00:00
/*
* FreeSWITCH Modular Media Switching Software Library / Soft - Switch Application
* Copyright ( C ) 2005 / 2006 , Anthony Minessale II < anthmct @ yahoo . com >
*
* 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 < anthmct @ yahoo . com >
* Portions created by the Initial Developer are Copyright ( C )
* the Initial Developer . All Rights Reserved .
*
* Contributor ( s ) :
*
* Anthony Minessale II < anthmct @ yahoo . com >
*
*
* mod_perl . c - - Perl
*
*/
2006-03-30 23:02:50 +00:00
# ifdef __ICC
# pragma warning (disable:1419)
# endif
2006-03-06 00:02:45 +00:00
# ifdef _MSC_VER
# include <perlibs.h>
# pragma comment(lib, PERL_LIB)
# endif
2006-03-03 16:57:21 +00:00
# include <EXTERN.h>
# include <perl.h>
2006-03-06 00:02:45 +00:00
# include <switch.h>
2006-03-03 16:57:21 +00:00
static char * embedding [ ] = { " " , " -e " , " " } ;
EXTERN_C void xs_init ( pTHX ) ;
static const char modname [ ] = " mod_perl " ;
static struct {
PerlInterpreter * my_perl ;
} globals ;
static void destroy_perl ( PerlInterpreter * * to_destroy )
{
perl_destruct ( * to_destroy ) ;
perl_free ( * to_destroy ) ;
* to_destroy = NULL ;
}
static PerlInterpreter * clone_perl ( void )
{
return perl_clone ( globals . my_perl , CLONEf_COPY_STACKS | CLONEf_KEEP_PTR_TABLE ) ;
}
2006-04-29 06:05:03 +00:00
static void perl_function ( switch_core_session_t * session , char * data )
2006-03-03 16:57:21 +00:00
{
char * uuid = switch_core_session_get_uuid ( session ) ;
char code [ 1024 ] ;
PerlInterpreter * my_perl = clone_perl ( ) ;
sprintf ( code , " package fs_perl; \n "
" $SWITCH_ENV{UUID} = \" %s \" ; \n "
" chdir( \" %s/perl \" ); \n " ,
uuid , SWITCH_GLOBAL_dirs . base_dir ) ;
Perl_eval_pv ( my_perl , code , TRUE ) ;
Perl_eval_pv ( my_perl , data , TRUE ) ;
destroy_perl ( & my_perl ) ;
}
2006-04-29 23:43:28 +00:00
static const switch_application_interface_t perl_application_interface = {
2006-03-03 16:57:21 +00:00
/*.interface_name */ " perl " ,
2007-02-26 21:38:10 +00:00
/*.application_function */ perl_function ,
NULL , NULL , NULL ,
/* flags */ SAF_NONE , /* should we support no media mode here? If so, we need to detect the mode, and either disable the media functions or indicate media if/when we need */
/*.next*/ NULL
2006-03-03 16:57:21 +00:00
} ;
2006-04-29 23:43:28 +00:00
static switch_loadable_module_interface_t perl_module_interface = {
2006-03-03 16:57:21 +00:00
/*.module_name */ modname ,
/*.endpoint_interface */ NULL ,
/*.timer_interface */ NULL ,
/*.dialplan_interface */ NULL ,
/*.codec_interface */ NULL ,
/*.application_interface */ & perl_application_interface ,
/*.api_interface */ NULL ,
/*.file_interface */ NULL ,
/*.speech_interface */ NULL ,
/*.directory_interface */ NULL
} ;
2006-04-29 23:43:28 +00:00
SWITCH_MOD_DECLARE ( switch_status_t ) switch_module_shutdown ( void )
2006-03-03 16:57:21 +00:00
{
if ( globals . my_perl ) {
perl_destruct ( globals . my_perl ) ;
perl_free ( globals . my_perl ) ;
globals . my_perl = NULL ;
2006-04-16 06:05:53 +00:00
switch_log_printf ( SWITCH_CHANNEL_LOG , SWITCH_LOG_INFO , " Unallocated perl interpreter. \n " ) ;
2006-03-03 16:57:21 +00:00
}
return SWITCH_STATUS_SUCCESS ;
}
2006-04-30 18:24:24 +00:00
SWITCH_MOD_DECLARE ( switch_status_t ) switch_module_load ( const switch_loadable_module_interface_t * * module_interface , char * filename )
2006-03-03 16:57:21 +00:00
{
PerlInterpreter * my_perl ;
char code [ 1024 ] ;
if ( ! ( my_perl = perl_alloc ( ) ) ) {
2006-04-16 06:05:53 +00:00
switch_log_printf ( SWITCH_CHANNEL_LOG , SWITCH_LOG_ERROR , " Could not allocate perl intrepreter \n " ) ;
2006-03-03 16:57:21 +00:00
return SWITCH_STATUS_MEMERR ;
}
2006-04-16 06:05:53 +00:00
switch_log_printf ( SWITCH_CHANNEL_LOG , SWITCH_LOG_INFO , " Allocated perl intrepreter. \n " ) ;
2006-03-03 16:57:21 +00:00
PERL_SET_CONTEXT ( my_perl ) ;
perl_construct ( my_perl ) ;
perl_parse ( my_perl , xs_init , 3 , embedding , NULL ) ;
perl_run ( my_perl ) ;
globals . my_perl = my_perl ;
sprintf ( code , " use lib '%s/perl';use fs_perl;use freeswitch \n " , SWITCH_GLOBAL_dirs . base_dir ) ;
Perl_eval_pv ( my_perl , code , TRUE ) ;
/* connect my internal structure to the blank pointer passed to me */
2006-04-30 18:24:24 +00:00
* module_interface = & perl_module_interface ;
2006-03-03 16:57:21 +00:00
/* indicate that the module should continue to be loaded */
return SWITCH_STATUS_SUCCESS ;
}
2006-11-27 22:30:48 +00:00
/* For Emacs:
* Local Variables :
* mode : c
2007-02-09 02:36:03 +00:00
* indent - tabs - mode : t
2006-11-27 22:30:48 +00:00
* tab - width : 4
* c - basic - offset : 4
* End :
* For VIM :
* vim : set softtabstop = 4 shiftwidth = 4 tabstop = 4 expandtab :
*/