C++ perl_destruct函数代码示例

/* Destroy all perl scripts and deinitialize perl interpreter */
void perl_scripts_deinit(void)
{
	if (my_perl == NULL)
		return;

	/* unload all scripts */
        while (perl_scripts != NULL)
		perl_script_unload(perl_scripts->data);

        signal_emit("perl scripts deinit", 0);

        perl_signals_stop();
	perl_sources_stop();
	perl_common_stop();

	/* Unload all perl libraries loaded with dynaloader */
	perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE);

	/* We could unload all libraries .. but this crashes with some
	   libraries, probably because we don't call some deinit function..
	   Anyway, this would free some memory with /SCRIPT RESET, but it
	   leaks memory anyway. */
	/*perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);*/

	/* perl interpreter */
	perl_destruct(my_perl);
	perl_free(my_perl);
	my_perl = NULL;
}

/* ---- special pearl parser ----- */
int perl_parse_buf (char *inBuf) {
	
	STRLEN n_a;
	char *embedding[] = { "", "-e", "" };

	
	if (!my_perl) {
		my_perl = perl_alloc();
		perl_construct( my_perl );
		perl_parse(my_perl, xs_init, 3, embedding, NULL);
		/* PL_exit_flags |= PERL_EXIT_DESTRUCT_END; */
		perl_run(my_perl);
	}

/* 	sv_setpv(text,inBuf); */
/* 	eval_sv(text,G_SCALAR); */

	perlBuf = eval_pv(inBuf, TRUE);
	
	if (0) {
		perl_destruct(my_perl);
		perl_free(my_perl);
	}

	return 0;
	
}

static void rlm_perl_destruct(PerlInterpreter *perl)
{
	dTHXa(perl);

	PERL_SET_CONTEXT(perl);

	PL_perl_destruct_level = 2;

	PL_origenviron = environ;


	{
		dTHXa(perl);
	}
	/*
	 * FIXME: This shouldn't happen
	 *
	 */
	while (PL_scopestack_ix > 1) {
		LEAVE;
	}

	perl_destruct(perl);
	perl_free(perl);
}

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();
}

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
}

void h3(void *arg) {
    int argc = 3;
    char *argv[] = { "", "-e", "use Data::Dumper;"
        "sub dump_perl { print STDERR Data::Dumper::Dumper([shift]); }", 
            NULL };
    char *env[] = { NULL };
    void *original_context = PERL_GET_CONTEXT;
    SV *sv;

    PERL_SYS_INIT3(&argc,&argv,&env);
    my_perl = perl_alloc();

    sv = newRV_inc(newSViv(5));

    PERL_SET_CONTEXT(my_perl);
    perl_construct(my_perl);
    
    perl_parse(my_perl, mine_xs_init, argc, argv, NULL);

    call_dump_perl(sv);
    
    perl_destruct(my_perl);
    perl_free(my_perl);

    PERL_SET_CONTEXT(original_context);
}

static void irssi_perl_stop(void)
{
	g_hash_table_foreach(first_signals, (GHFunc) signal_destroy_hash, NULL);
	g_hash_table_destroy(first_signals);
	g_hash_table_foreach(last_signals, (GHFunc) signal_destroy_hash, NULL);
	g_hash_table_destroy(last_signals);
	first_signals = last_signals = NULL;

	if (signal_grabbed) {
		signal_grabbed = FALSE;
		signal_remove("signal", (SIGNAL_FUNC) sig_signal);
	}

	if (siglast_grabbed) {
		siglast_grabbed = FALSE;
		signal_remove("last signal", (SIGNAL_FUNC) sig_lastsignal);
	}

	while (perl_timeouts != NULL)
		perl_timeout_destroy(perl_timeouts->data);

	perl_destruct(irssi_perl_interp);
	perl_free(irssi_perl_interp);
	irssi_perl_interp = NULL;
}

void Embperl::Reinit() {
	in_use = true;
	PL_perl_destruct_level = 1;
	perl_destruct(my_perl);
	DoInit();
	in_use = false;
}

int
ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl)
{
	int ret = perl_destruct(my_perl);		// Destructor for Perl.
////	perl_free(my_perl);			// Free the memory allocated for Perl.
	return(ret);
}

static void destroy_perl(PerlInterpreter ** to_destroy)
{
	Perl_safe_eval(*to_destroy, HACK_CLEAN_CODE);
	perl_destruct(*to_destroy);
	perl_free(*to_destroy);
	*to_destroy = NULL;
}

void
weechat_perl_unload (struct t_plugin_script *script)
{
    int *rc;
    void *interpreter;
    char *filename;

    if ((weechat_perl_plugin->debug >= 2) || !perl_quiet)
    {
        weechat_printf (NULL,
                        weechat_gettext ("%s: unloading script \"%s\""),
                        PERL_PLUGIN_NAME, script->name);
    }

#ifdef MULTIPLICITY
    PERL_SET_CONTEXT (script->interpreter);
#endif /* MULTIPLICITY */

    if (script->shutdown_func && script->shutdown_func[0])
    {
        rc = (int *)weechat_perl_exec (script,
                                       WEECHAT_SCRIPT_EXEC_INT,
                                       script->shutdown_func,
                                       NULL, NULL);
        if (rc)
            free (rc);
    }

    filename = strdup (script->filename);
    interpreter = script->interpreter;

    if (perl_current_script == script)
    {
        perl_current_script = (perl_current_script->prev_script) ?
            perl_current_script->prev_script : perl_current_script->next_script;
    }

    plugin_script_remove (weechat_perl_plugin, &perl_scripts, &last_perl_script,
                          script);

#ifdef MULTIPLICITY
    if (interpreter)
    {
        perl_destruct (interpreter);
        perl_free (interpreter);
    }
    if (perl_current_script)
    {
        PERL_SET_CONTEXT (perl_current_script->interpreter);
    }
#else
    if (interpreter)
        free (interpreter);
#endif /* MULTIPLICITY */

    (void) weechat_hook_signal_send ("perl_script_unloaded",
                                     WEECHAT_HOOK_SIGNAL_STRING, filename);
    if (filename)
        free (filename);
}

/* Stopping has one big memory leak right now, so it's not used. */
void	perlstartstop (int startnotstop) 
{
	if (startnotstop && !isperlrunning) {
		char *embedding[3];
		embedding[0] = malloc_strdup(empty_string);
		embedding[1] = malloc_strdup("-e");
		embedding[2] = malloc_strdup("$SIG{__DIE__}=$SIG{__WARN__}=\\&EPIC::yell;");

		++isperlrunning;
		my_perl = perl_alloc();
		perl_construct( my_perl );
		perl_parse(my_perl, xs_init, 3, embedding, NULL);
		if (SvTRUE(ERRSV)) 
			yell("perl_parse: %s", SvPV_nolen(ERRSV));
		perl_run(my_perl);
		if (SvTRUE(ERRSV)) 
			yell("perl_run: %s", SvPV_nolen(ERRSV));
	} else if (!startnotstop && isperlrunning && !perlcalldepth) {
		perl_destruct(my_perl);
		if (SvTRUE(ERRSV)) 
			yell("perl_destruct: %s", SvPV_nolen(ERRSV));
		perl_free(my_perl);
		if (SvTRUE(ERRSV)) 
			yell("perl_free: %s", SvPV_nolen(ERRSV));
		isperlrunning=0;
	}
}

int script_free()
{
	perl_destruct(my_perl);
	perl_free(my_perl);

	return 0;
}

int unload_perl__( void )
{
  int i;

#ifdef MULTI_THREAD
  if( NULL == th)
	th = xsb_get_main_thread();
#endif

  PL_perl_destruct_level = 1;
  perl_destruct( my_perl );
  perl_free( my_perl );

  /*-------------------------------------------------------------------------
   free all the space allocated for perl match functions
  -------------------------------------------------------------------------*/
  for ( i=0; i<preBulkMatchNumber; i++ ) 
    free(bulkMatchList[i]);
  if (bulkMatchList != NULL ) free(bulkMatchList);
  if (matchPattern != NULL ) free(matchPattern);
  if (substituteString != NULL ) free(substituteString);
  free(subMatchSpec);

  perlObjectStatus = UNLOADED;

  return SUCCESS;
}  

main (int argc, char **argv, char **env)
{
	STRLEN n_a;
	char *embedding[] = { "", "-e", "0" };
   
	my_perl = perl_alloc();
	perl_construct( my_perl );
   
	perl_parse(my_perl, NULL, 3, embedding, NULL);
	perl_run(my_perl);
   
	/** Treat $a as an integer **/
	perl_eval_pv("$a = 3; $a **= 2", TRUE);
	printf("a = %d\n", SvIV(perl_get_sv("a", FALSE)));
   
	/** Treat $a as a float **/
	perl_eval_pv("$a = 3.14; $a **= 2", TRUE);
	printf("a = %f\n", SvNV(perl_get_sv("a", FALSE)));
   
	/** Treat $a as a string **/
	perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
	printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a));
   
	perl_destruct(my_perl);
	perl_free(my_perl);
}