static int
perl_command_unloadall (char *word[], char *word_eol[], void *userdata)
{
if (my_perl != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), "");
return XCHAT_EAT_XCHAT;
}
return XCHAT_EAT_XCHAT;
}
static int
perl_command_reload (char *word[], char *word_eol[], void *userdata)
{
char *file = get_filename (word, word_eol);
if (my_perl != NULL && file != NULL) {
execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload", 0)), file);
return XCHAT_EAT_XCHAT;
}
return XCHAT_EAT_XCHAT;
}
static int
perl_load_file (char *filename)
{
#ifdef WIN32
static HMODULE lib = NULL;
if (!lib) {
lib = LoadLibraryA (PERL_DLL);
if (!lib) {
if (GetLastError () == ERROR_BAD_EXE_FORMAT)
/* http://forum.xchat.org/viewtopic.php?t=3277 */
thread_mbox ("Cannot use this " PERL_DLL "\n\n"
"32-bit ActivePerl is required.");
else {
/* a lot of people install this old version */
lib = LoadLibraryA ("perl56.dll");
if (lib) {
FreeLibrary (lib);
lib = NULL;
thread_mbox ("Cannot open " PERL_DLL "\n\n"
"You must have either ActivePerl or Straberry Perl"
PERL_REQUIRED_VERSION
" installed in order to\n"
"run perl scripts.\n\n"
"I have found Perl 5.6, but that is too old.");
} else {
thread_mbox ("Cannot open " PERL_DLL "\n\n"
"You must have either ActivePerl or Strawberry Perl "
PERL_REQUIRED_VERSION " installed in order to\n"
"run perl scripts.\n\n"
"http://www.activestate.com/ActivePerl/\n"
"http://strawberryperl.com/\n"
"Make sure perl's bin directory is in your PATH.");
}
}
/* failure */
return FALSE;
}
/* success */
FreeLibrary (lib);
}
#endif
if (my_perl == NULL) {
perl_init ();
}
return execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::load", 0)),
filename);
}
/**
* example command
* Just sends "Hello World!" to the services channel
*/
static int load_extension( const CmdParams *cmdparams )
{
SET_SEGV_LOCATION();
irc_chanalert( perl_bot, "%s is trying to load perl extension %s",
cmdparams->source->name, cmdparams->av[0] );
if (load_perlextension(cmdparams->av[0], perl_ext_init, cmdparams->source)) {
perl_sync_module(GET_CUR_MODULE());
} else {
return NS_FAILURE;
}
execute_perl(GET_CUR_MODULE(), sv_2mortal (newSVpv ("NeoStats::Module::extension_2eple::TestCall", 0)), 1, "Hello World");
return NS_SUCCESS;
}
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;
}
}
static gboolean
load_perl_plugin(PurplePlugin *plugin)
{
PurplePerlScript *gps = (PurplePerlScript *)plugin->info->extra_info;
char *atmp[3] = { plugin->path, NULL, NULL };
if (gps == NULL || gps->load_sub == NULL)
return FALSE;
purple_debug(PURPLE_DEBUG_INFO, "perl", "Loading perl script\n");
if (my_perl == NULL)
perl_init();
plugin->handle = gps;
atmp[1] = gps->package;
PERL_SET_CONTEXT(my_perl);
execute_perl("Purple::PerlLoader::load_n_eval", 2, atmp);
{
dSP;
PERL_SET_CONTEXT(my_perl);
SPAGAIN;
ENTER;
SAVETMPS;
PUSHMARK(sp);
XPUSHs(sv_2mortal(purple_perl_bless_object(plugin,
"Purple::Plugin")));
PUTBACK;
perl_call_pv(gps->load_sub, G_EVAL | G_SCALAR);
SPAGAIN;
if (SvTRUE(ERRSV)) {
STRLEN len;
purple_debug(PURPLE_DEBUG_ERROR, "perl",
"Perl function %s exited abnormally: %s\n",
gps->load_sub, SvPV(ERRSV, len));
}
PUTBACK;
FREETMPS;
LEAVE;
}
return TRUE;
}
