bool OnLoad(const CString& sArgsi, CString& sMessage) {
CString sModPath, sTmp;
if (!CModules::FindModPath("modperl/startup.pl", sModPath, sTmp)) {
sMessage = "startup.pl not found.";
return false;
}
sTmp = CDir::ChangeDir(sModPath, "..");
int argc = 6;
char *pArgv[] = {"", "-T", "-w",
"-I", const_cast<char*>(sTmp.c_str()),
const_cast<char*>(sModPath.c_str()), NULL};
char **argv = pArgv;
PERL_SYS_INIT3(&argc, &argv, &environ);
m_pPerl = perl_alloc();
perl_construct(m_pPerl);
if (perl_parse(m_pPerl, xs_init, argc, argv, environ)) {
perl_free(m_pPerl);
PERL_SYS_TERM();
m_pPerl = NULL;
sMessage = "Can't initialize perl.";
DEBUG(__PRETTY_FUNCTION__ << " can't init perl");
return false;
}
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
PSTART;
PCALL("ZNC::Core::Init");
PEND;
return true;
}
static void
ngx_http_perl_exit(ngx_cycle_t *cycle)
{
#if (NGX_HAVE_PERL_MULTIPLICITY)
/*
* the master exit hook is run before global pool cleanup,
* therefore just set flag here
*/
ngx_perl_term = 1;
#else
if (nginx_stash) {
ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term");
(void) perl_destruct(perl);
perl_free(perl);
PERL_SYS_TERM();
}
#endif
}
int main(int argc, char **argv, char **env)
{
//if (argc < 2) {
// fprintf(stderr, "you must specify at least one argument\n");
// exit(0);
//}
pthread_t threads[NUM_THREADS];
pthread_mutex_init(&mutex_perl, NULL);
PERL_SYS_INIT3(&argc,&argv,&env);
char *my_argv[] = { "", PERL_SCRIPT };
my_perl = perl_alloc();
PERL_SET_CONTEXT(my_perl);
perl_construct(my_perl);
perl_parse(my_perl, NULL, 2, my_argv, (char **)NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run(my_perl);
int t;
for (t=0; t<NUM_THREADS; t++) {
printf("creating thread %d\n", t);
(void)pthread_create(&threads[t], NULL, thread_context, (void *)t);
}
for (t=0;t<NUM_THREADS;t++) {
(void)pthread_join(threads[t], NULL);
printf("joined thread %d\n", t);
}
perl_destruct(my_perl);
perl_free(my_perl);
pthread_exit(NULL);
pthread_mutex_destroy(&mutex_perl);
PERL_SYS_TERM();
}
/*
* destroy
* called by opensips at exit time
*/
static void destroy(void)
{
if(my_perl==NULL)
return;
unload_perl(my_perl);
PERL_SYS_TERM();
my_perl = NULL;
}
static void
PurlDestroy()
{
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
void
cleanup_perl(struct module *module)
{
precleanup_perl(module);
#ifdef PERL_SYS_TERM
PERL_SYS_TERM();
#endif
}
void perl_core_deinit(void)
{
perl_scripts_deinit();
perl_signals_deinit();
signal_remove("script error", (SIGNAL_FUNC) sig_script_error);
PERL_SYS_TERM();
}
virtual ~CModPerl() {
if (m_pPerl) {
PSTART;
PCALL("ZNC::Core::UnloadAll");
PEND;
perl_destruct(m_pPerl);
perl_free(m_pPerl);
PERL_SYS_TERM();
}
}
void nsperl2_free_master_context (void *context)
{
extern perl_master_context *nsperl2_master_context;
assert (nsperl2_master_context);
Ns_Log (Notice, "in nsperl2_free_master_context - about to free and destruct master perl context");
PERL_SET_CONTEXT (nsperl2_master_context->perl_master_interp);
perl_destruct (nsperl2_master_context->perl_master_interp);
perl_free (nsperl2_master_context->perl_master_interp);
PERL_SYS_TERM();
}
/*
* destroy
* called by kamailio at exit time
*/
static void destroy(void)
{
if(_ap_reset_cycles!=NULL)
shm_free(_ap_reset_cycles);
_ap_reset_cycles = NULL;
if(my_perl==NULL)
return;
unload_perl(my_perl);
PERL_SYS_TERM();
my_perl = NULL;
}
static bool perlcore_module_cleanup(KviModule *)
{
#ifdef COMPILE_PERL_SUPPORT
perlcore_destroy_all_interpreters();
delete g_pInterpreters;
g_pInterpreters = 0;
// ifdef workaround for #842
#ifndef COMPILE_ON_MAC
PERL_SYS_TERM();
#endif
#endif // COMPILE_PERL_SUPPORT
return true;
}
static apr_status_t psgi_child_exit(void *p)
{
if (perlinterp != NULL) {
PERL_SET_CONTEXT(perlinterp);
PL_perl_destruct_level = 1;
perl_destruct(perlinterp);
perl_free(perlinterp);
PERL_SYS_TERM();
perlinterp = NULL;
}
return OK;
}
int main(int argc, char *argv[])
{
char **env = environ;
PERL_SYS_INIT3(&argc,&argv, &env);
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
perl_run(my_perl);
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
static void
ngx_http_perl_cleanup_perl(void *data)
{
PerlInterpreter *perl = data;
PERL_SET_CONTEXT(perl);
(void) perl_destruct(perl);
perl_free(perl);
if (ngx_perl_term)
{
ngx_log_debug0(NGX_LOG_DEBUG_HTTP, ngx_cycle->log, 0, "perl term");
PERL_SYS_TERM();
}
}
int
main( int argc, char **argv, char **env ) {
int exit_status;
#ifdef PERL_GLOBAL_STRUCT
#define PERLVAR(var,type) /**/
#define PERLVARA(var,type) /**/
#define PERLVARI(var,type,init) PL_Vars.var = init;
#define PERLVARIC(var,type,init) PL_Vars.var = init;
#include "perlvars.h"
#undef PERLVAR
#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#endif
PERL_GPROF_MONCONTROL( 0 );
PERL_SYS_INIT3( &argc, &argv, &env );
#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
PTHREAD_ATFORK( Perl_atfork_lock,
Perl_atfork_unlock, Perl_atfork_unlock );
#endif
if ( !PL_do_undump ) {
my_perl = perl_alloc( );
if ( !my_perl ) {
exit( 1 );
}
perl_construct( my_perl );
PL_perl_destruct_level = 0;
}
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
exit_status = perl_parse( my_perl, xs_init, argc, argv, NULL );
if ( !exit_status ) {
runops_hook( );
perl_run( my_perl );
}
exit_status = perl_destruct( my_perl );
perl_free( my_perl );
PERL_SYS_TERM( );
exit( exit_status );
return exit_status;
}
static void
perl_end (void)
{
if (my_perl != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), "");
PL_perl_destruct_level = 1;
perl_destruct (my_perl);
perl_free (my_perl);
PERL_SYS_TERM();
my_perl = NULL;
}
}
void
ngx_http_psgi_perl_exit(ngx_cycle_t *cycle)
{
ngx_http_psgi_main_conf_t *psgimcf =
ngx_http_cycle_get_module_main_conf(cycle, ngx_http_psgi_module);
ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "psgi perl term");
(void) perl_destruct(psgimcf->perl);
perl_free(psgimcf->perl);
PERL_SYS_TERM();
}
void p5_destruct_perl(PerlInterpreter *my_perl) {
PERL_SET_CONTEXT(my_perl);
PL_perl_destruct_level = 1;
POPSTACK_TO(PL_mainstack);
dounwind(-1);
LEAVE_SCOPE(0);
perl_destruct(my_perl);
perl_free(my_perl);
if (--interpreters == 0 && terminate)
PERL_SYS_TERM();
}
int proxenet_perl_destroy_vm(interpreter_t* interpreter)
{
perl_destruct(my_perl);
perl_free(my_perl);
my_perl = NULL;
/* Looks like this macro segfaults on FreeBSD and OSX.... */
#if defined(PERL_SYS_TERM) && !defined(__FreeBSD__) && !defined(__DARWIN__)
PERL_SYS_TERM ();
#endif
interpreter->vm = NULL;
interpreter->ready = false;
return 0;
}
static void shutdown_perl(void)
{
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
my_perl = 0;
PERL_SYS_TERM();
if (libperl_handle)
{
dlclose(libperl_handle);
libperl_handle = NULL;
}
free_object_list();
}
static void
ngx_http_perl_exit(ngx_cycle_t *cycle)
{
ngx_http_perl_main_conf_t *pmcf;
pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module);
{
dTHXa(pmcf->perl);
PERL_SET_CONTEXT(pmcf->perl);
PERL_SYS_TERM();
}
}
int
perl_back_close(
BackendInfo *bd
)
{
perl_destruct(PERL_INTERPRETER);
perl_free(PERL_INTERPRETER);
PERL_INTERPRETER = NULL;
#ifdef PERL_SYS_TERM
PERL_SYS_TERM();
#endif
ldap_pvt_thread_mutex_destroy( &perl_interpreter_mutex );
return 0;
}
Embperl::~Embperl()
{
in_use = true;
#ifdef EMBPERL_IO_CAPTURE
eval_pv(
"package quest;"
" if(tied *STDOUT) { untie(*STDOUT); }"
" if(tied *STDERR) { untie(*STDERR); }"
,FALSE);
#endif
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
my_perl = NULL;
}
int PerlShutdown()
{
#ifdef PAYGUIDE_PERL
if (argv!=NULL)
{
if (argv[0]!=NULL)
delete [] argv[0];
if (argv[1]!=NULL)
delete [] argv[1];
delete [] argv;
}
argv=NULL;
PERL_SYS_TERM();
#endif
return 0;
}
int
weechat_plugin_end (struct t_weechat_plugin *plugin)
{
/* unload all scripts */
perl_quiet = 1;
if (perl_script_eval)
{
weechat_perl_unload (perl_script_eval);
perl_script_eval = NULL;
}
plugin_script_end (plugin, &perl_data);
perl_quiet = 0;
#ifndef MULTIPLICITY
/* free perl interpreter */
if (perl_main)
{
perl_destruct (perl_main);
perl_free (perl_main);
perl_main = NULL;
}
#endif /* MULTIPLICITY */
#if defined(PERL_SYS_TERM) && !defined(__FreeBSD__) && !defined(WIN32) && !defined(__CYGWIN__) && !(defined(__APPLE__) && defined(__MACH__))
/*
* we call this function on all OS, but NOT on FreeBSD or Cygwin,
* because it crashes with no reason (bug in Perl?)
*/
if (perl_quit_or_upgrade)
PERL_SYS_TERM ();
#endif
/* free some data */
if (perl_action_install_list)
free (perl_action_install_list);
if (perl_action_remove_list)
free (perl_action_remove_list);
if (perl_action_autoload_list)
free (perl_action_autoload_list);
weechat_string_dyn_free (perl_buffer_output, 1);
return WEECHAT_RC_OK;
}
static int mod_detach(void *instance)
{
rlm_perl_t *inst = (rlm_perl_t *) instance;
int exitstatus = 0, count = 0;
if (inst->rad_perlconf_hv != NULL) hv_undef(inst->rad_perlconf_hv);
if (inst->perl_parsed && inst->func_detach) {
dTHXa(inst->perl);
PERL_SET_CONTEXT(inst->perl);
{
dSP; ENTER; SAVETMPS;
PUSHMARK(SP);
count = call_pv(inst->func_detach, G_SCALAR | G_EVAL );
SPAGAIN;
if (count == 1) {
exitstatus = POPi;
if (exitstatus >= 100 || exitstatus < 0) {
exitstatus = RLM_MODULE_FAIL;
}
}
PUTBACK;
FREETMPS;
LEAVE;
}
}
#ifdef USE_ITHREADS
rlm_perl_destruct(inst->perl);
pthread_mutex_destroy(&inst->clone_mutex);
#else
perl_destruct(inst->perl);
perl_free(inst->perl);
#endif
PERL_SYS_TERM();
return exitstatus;
}
int main(int argc, char** argv) {
PERL_SYS_INIT3(NULL, NULL, NULL);
{
interp a, b;
boost::thread th1 = boost::thread(boost::bind(&interp::process, &a, "thread 1"));
boost::thread th2 = boost::thread(boost::bind(&interp::process, &b, "thread 2"));
sleep(3);
a.stopping = true;
b.stopping = true;
th1.join();
th2.join();
}
PERL_SYS_TERM();
return 0;
}
/*
* Frees the internal data-structures of the library.
*/
void
fwstub_close(void *handle)
{
struct _plugin_data *pdata;
if(!handle) printf("empty handle \n");
if(!handle || (handle != ((struct _plugin_data *) handle)->handle) ){
printf("fwstub_close: plugin handle invalid\n");
return ;
}
pdata = (struct _plugin_data *) handle ;
/* release configuratio file path memory */
if(pdata->conf_filepath) {
free(pdata->conf_filepath);
pdata->conf_filepath = NULL;
}
/* release plugin data */
free(handle);
handle = NULL ;
/* decrease reference count and if it became '0', release plugin's global resources */
g_lib_refcount--;
if(g_lib_refcount == 0) {
// release_plugin_gdata();
//Function not defined yet bcos
//config.c doesnt have a routine to free global data
}
#ifdef REGEX
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
#endif
return;
}
static apr_status_t perl_metric_cleanup(void *data)
{
mapped_info_t *mi, *smi;
int i, j;
mi = (mapped_info_t*) metric_mapping_info->elts;
for (i = 0; i < metric_mapping_info->nelts; i++) {
if (mi[i].mod_name) {
/* XXX: Should work but segfault...
if (mi[i].perl != NULL) {
PERL_SET_CONTEXT(mi[i].perl);
perl_destruct(mi[i].perl);
PERL_SET_CONTEXT(mi[i].perl);
perl_free(mi[i].perl);
}
*/
/* Set all modules that fall after this once with the same
* module pointer to NULL so metric_cleanup only gets called
* once on the module.
*/
smi = (mapped_info_t*) metric_mapping_info->elts;
for (j = i+1; j < metric_mapping_info->nelts; j++) {
if (smi[j].mod_name == mi[i].mod_name) {
smi[j].mod_name = NULL;
}
}
}
}
PERL_SYS_TERM();
return APR_SUCCESS;
}
static void
ngx_http_perl_exit(ngx_cycle_t *cycle)
{
#if (NGX_HAVE_PERL_MULTIPLICITY)
ngx_perl_term = 1;
#else
ngx_http_perl_main_conf_t *pmcf;
pmcf = ngx_http_cycle_get_module_main_conf(cycle, ngx_http_perl_module);
if (pmcf && nginx_stash) {
ngx_log_debug0(NGX_LOG_DEBUG_HTTP, cycle->log, 0, "perl term");
(void) perl_destruct(pmcf->perl);
perl_free(pmcf->perl);
PERL_SYS_TERM();
}
#endif
}
