[NeoStats-Devel] [Commits] r2799 - trunk/src
[email protected] Mon, 12 Sep 2005 22:45:06 +1000
| Newsgroups | gmane.comp.neostats.devel |
|---|---|
| Message-ID | <[email protected]> |
Author: Fish
Date: Mon Sep 12 20:45:00 2005
New Revision: 2799
Modified:
trunk/src/nsevents.c
trunk/src/perl.c
Log:
Perl Extensions?!
Modified: trunk/src/nsevents.c
==============================================================================
--- trunk/src/nsevents.c (original)
+++ trunk/src/nsevents.c Mon Sep 12 20:45:00 2005
@@ -120,69 +120,111 @@
void SendModuleEvent( Event event, CmdParams *cmdparams, Module *module_ptr )
{
+ ModuleEvent **evt;
+#ifdef USE_PERL
+ int inperl = 0;
+#endif
SET_SEGV_LOCATION();
dlog( DEBUG5, "SendModuleEvent: %s to module %s", EventStrings[event], module_ptr->info->name );
- if( !module_ptr->event_list )
- {
- dlog( DEBUG5, "SendModuleEvent: module %s has no events associated with it", module_ptr->info->name );
- return;
- }
- if( module_ptr->event_list[event] )
- {
- /* If we are not yet synched, check that the module supports
- * the event before we are synched. */
- if( !IsModuleSynched( module_ptr ) && !( module_ptr->event_list[event]->flags & EVENT_FLAG_IGNORE_SYNCH ) )
- {
- dlog( DEBUG5, "Skipping module %s for %s since module is not yet synched", module_ptr->info->name, EventStrings[event] );
- return;
- }
- if( ( module_ptr->event_list[event]->flags & EVENT_FLAG_DISABLED ) )
- {
- dlog( DEBUG5, "Skipping module %s for %s since it is disabled", module_ptr->info->name, EventStrings[event] );
- return;
- }
- if( ( module_ptr->event_list[event]->flags & EVENT_FLAG_EXCLUDE_ME ) && IsMe( cmdparams->source ) )
+
+ /* if the C event list isn't populated */
+ if( !module_ptr->event_list) {
+#ifdef USE_PERL
+ /* and the Perl event list isn't populated either */
+ if (!(module_ptr->pm && module_ptr->pm->event_list))
+#endif
{
- dlog( DEBUG5, "Skipping module %s for %s since %s is excluded as a NeoStats client", module_ptr->info->name, EventStrings[event], cmdparams->source->name );
+ /* then bail out */
+ dlog( DEBUG5, "SendModuleEvent: module %s has no events associated with it", module_ptr->info->name );
return;
+ } else {
+ /* otherwise, we have a perl event, but not a C Event */
+ evt = module_ptr->pm->event_list;
+ inperl = 1;
}
- if( module_ptr->event_list[event]->flags & EVENT_FLAG_EXCLUDE_MODME )
+ } else {
+ /* we have a C event, so process this first, and at the bottom, switch to perl events */
+ evt = module_ptr->event_list;
+ }
+ while (1) {
+ if( evt[event] )
{
- if( cmdparams->source && cmdparams->source->user && cmdparams->source->user->bot && cmdparams->source->user->bot->moduleptr == module_ptr )
+ /* If we are not yet synched, check that the module supports
+ * the event before we are synched. */
+ if( !IsModuleSynched( module_ptr ) && !( evt[event]->flags & EVENT_FLAG_IGNORE_SYNCH ) )
{
- dlog( DEBUG5, "Skipping module %s for %s since %s is excluded as a Module client", module_ptr->info->name, EventStrings[event], cmdparams->source->name );
+ dlog( DEBUG5, "Skipping module %s for %s since module is not yet synched", module_ptr->info->name, EventStrings[event] );
return;
}
- }
- if( ( module_ptr->event_list[event]->flags & EVENT_FLAG_USE_EXCLUDE ) && IsExcluded( cmdparams->source ) )
- {
- dlog( DEBUG5, "Skipping module %s for %s since %s is excluded", module_ptr->info->name, EventStrings[event], cmdparams->source->name );
- return;
- }
- dlog( DEBUG1, "Running module %s with %s", module_ptr->info->name, EventStrings[event] );
- SET_SEGV_LOCATION();
- if( IS_STANDARD_MOD( module_ptr ) )
- {
- if( setjmp( sigvbuf ) == 0 )
+ if( ( evt[event]->flags & EVENT_FLAG_DISABLED ) )
{
- SET_RUN_LEVEL( module_ptr );
- module_ptr->event_list[event]->handler( cmdparams );
- RESET_RUN_LEVEL();
+ dlog( DEBUG5, "Skipping module %s for %s since it is disabled", module_ptr->info->name, EventStrings[event] );
+ return;
}
- else
+ if( ( evt[event]->flags & EVENT_FLAG_EXCLUDE_ME ) && IsMe( cmdparams->source ) )
{
- nlog( LOG_CRITICAL, "SendModuleEvent: setjmp() failed, not calling module %s", module_ptr->info->name );
+ dlog( DEBUG5, "Skipping module %s for %s since %s is excluded as a NeoStats client", module_ptr->info->name, EventStrings[event], cmdparams->source->name );
+ return;
+ }
+ if( evt[event]->flags & EVENT_FLAG_EXCLUDE_MODME )
+ {
+ if( cmdparams->source && cmdparams->source->user && cmdparams->source->user->bot && cmdparams->source->user->bot->moduleptr == module_ptr )
+ {
+ dlog( DEBUG5, "Skipping module %s for %s since %s is excluded as a Module client", module_ptr->info->name, EventStrings[event], cmdparams->source->name );
+ return;
+ }
+ }
+ if( ( evt[event]->flags & EVENT_FLAG_USE_EXCLUDE ) && IsExcluded( cmdparams->source ) )
+ {
+ dlog( DEBUG5, "Skipping module %s for %s since %s is excluded", module_ptr->info->name, EventStrings[event], cmdparams->source->name );
+ return;
+ }
+ dlog( DEBUG1, "Running module %s with %s", module_ptr->info->name, EventStrings[event] );
+ SET_SEGV_LOCATION();
+#ifdef USE_PERL
+ /* is this a C event */
+ if( inperl == 0 )
+#endif
+ {
+ if( setjmp( sigvbuf ) == 0 )
+ {
+ SET_RUN_LEVEL( module_ptr );
+ module_ptr->event_list[event]->handler( cmdparams );
+ RESET_RUN_LEVEL();
+ }
+ else
+ {
+ nlog( LOG_CRITICAL, "SendModuleEvent: setjmp() failed, not calling module %s", module_ptr->info->name );
+ }
}
- }
#if USE_PERL
- else if( IS_PERL_MOD( module_ptr ) )
- {
- SET_RUN_LEVEL( module_ptr );
- perl_event_cb( event, cmdparams, module_ptr );
- RESET_RUN_LEVEL();
- }
+ /* no, it must be a perl event */
+ else if( inperl == 1)
+ {
+ SET_RUN_LEVEL( module_ptr );
+ perl_event_cb( event, cmdparams, module_ptr );
+ RESET_RUN_LEVEL();
+ }
+#endif
+ }
+#ifdef USE_PERL
+ if (inperl == 0) {
+ /* if we just ran a C event list then check if the perl has a event list */
+ if (module_ptr->pm && module_ptr->pm->event_list) {
+ /* and if it does, process it */
+ evt = module_ptr->pm->event_list;
+ inperl = 1;
+ } else {
+ /* otherwise return, nothing else to do */
+ return;
+ }
+ } else {
+ /* if we are here, it means perl events have already run */
+ return;
+ }
+#else
+ return;
#endif
- return;
}
dlog( DEBUG5, "SendModuleEvent: %s has no event handler for %s", module_ptr->info->name, EventStrings[event] );
}
@@ -202,7 +244,7 @@
{
ModuleAllEvent *mae = (ModuleAllEvent *)v;
- if( module_ptr->event_list )
+ if( module_ptr->event_list || (module_ptr->pm && module_ptr->pm->event_list))
SendModuleEvent( mae->event, mae->cmdparams, module_ptr );
return NS_FALSE;
}
@@ -249,16 +291,25 @@
return;
}
mod_ptr = GET_CUR_MODULE();
- if( !mod_ptr->event_list )
- mod_ptr->event_list = ns_calloc( sizeof( ModuleEvent * ) * EVENT_COUNT );
+
dlog( DEBUG5, "AddEvent: adding %s to %s", EventStrings[eventptr->event], mod_ptr->info->name );
+
/* only standard modules have a handler, perl mods use a custom callback */
- if(IS_STANDARD_MOD(mod_ptr) && !eventptr->handler )
- {
- nlog( LOG_ERROR, "AddEvent: missing handler for %s in module %s", EventStrings[eventptr->event], mod_ptr->info->name );
- return;
+ if (!eventptr->pe) {
+ if(!eventptr->handler )
+ {
+ nlog( LOG_ERROR, "AddEvent: missing handler for %s in module %s", EventStrings[eventptr->event], mod_ptr->info->name );
+ return;
+ }
+ if( !mod_ptr->event_list )
+ mod_ptr->event_list = ns_calloc( sizeof( ModuleEvent * ) * EVENT_COUNT );
+ mod_ptr->event_list[eventptr->event] = eventptr;
+ } else {
+ if( !mod_ptr->pm->event_list )
+ mod_ptr->pm->event_list = ns_calloc( sizeof( ModuleEvent * ) * EVENT_COUNT );
+ mod_ptr->pm->event_list[eventptr->event] = eventptr;
}
- mod_ptr->event_list[eventptr->event] = eventptr;
+
if( eventptr->event == EVENT_NICKIP )
me.want_nickip = 1;
}
@@ -353,6 +404,13 @@
ns_free( mod_ptr->event_list );
mod_ptr->event_list = NULL;
}
+#ifdef USE_PERL
+ if ( mod_ptr->pm && mod_ptr->pm->event_list)
+ {
+ ns_free(mod_ptr->pm->event_list);
+ mod_ptr->pm->event_list = NULL;
+ }
+#endif
}
/** @brief SetAllEventFlags
Modified: trunk/src/perl.c
==============================================================================
--- trunk/src/perl.c (original)
+++ trunk/src/perl.c Mon Sep 12 20:45:00 2005
@@ -40,7 +40,7 @@
extern void boot_DynaLoader (pTHX_ CV * cv);
static void dump_hash(HV *rethash);
-
+XSINIT_t extn_init;
@@ -135,154 +135,154 @@
nlog(LOG_WARNING, "Ehhh, PerlModule got callback for EVENT_NULL?");
break;
case EVENT_MODULELOAD:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->param);
break;
case EVENT_MODULEUNLOAD:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->param);
break;
case EVENT_SERVER:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_SQUIT:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_PING:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_PONG:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_SIGNON:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_QUIT:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_NICKIP:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_KILL:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
break;
case EVENT_GLOBALKILL:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
break;
case EVENT_LOCALKILL:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
break;
case EVENT_SERVERKILL:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
break;
case EVENT_BOTKILL:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->target->name, cmdparams->param);
break;
case EVENT_NICK:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_AWAY:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_UMODE:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_SMODE:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_NEWCHAN:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->channel->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->channel->name);
break;
case EVENT_DELCHAN:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->channel->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->channel->name);
break;
case EVENT_JOIN:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->source->name);
break;
case EVENT_PART:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, (cmdparams->param == NULL ? 2 : 3), cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, (cmdparams->param == NULL ? 2 : 3), cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
break;
case EVENT_PARTBOT:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, (cmdparams->param == NULL ? 2 : 3), cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, (cmdparams->param == NULL ? 2 : 3), cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
break;
case EVENT_EMPTYCHAN:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->bot->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->bot->name);
break;
case EVENT_KICK:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 4, cmdparams->channel->name, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 4, cmdparams->channel->name, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
break;
case EVENT_KICKBOT:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 4, cmdparams->channel->name, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 4, cmdparams->channel->name, cmdparams->source->name, cmdparams->target->name, cmdparams->param);
break;
case EVENT_TOPIC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->source->name);
break;
case EVENT_CMODE:
dlog(DEBUG1, "EVENT_CMODE todo!");
break;
case EVENT_PRIVATE:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->bot->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->bot->name, cmdparams->param);
break;
case EVENT_NOTICE:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->bot->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->bot->name, cmdparams->param);
break;
case EVENT_CPRIVATE:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->channel->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->channel->name, cmdparams->param);
break;
case EVENT_CNOTICE:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->channel->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 3, cmdparams->source->name, cmdparams->channel->name, cmdparams->param);
break;
case EVENT_GLOBOPS:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_CHATOPS:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_WALLOPS:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_CTCPVERSIONRPL:
case EVENT_CTCPVERSIONRPLBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_CTCPVERSIONREQ:
case EVENT_CTCPVERSIONREQBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_CTCPFINGERRPL:
case EVENT_CTCPFINGERRPLBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_CTCPFINGERREQ:
case EVENT_CTCPFINGERREQBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_CTCPACTIONREQ:
case EVENT_CTCPACTIONREQBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_CTCPTIMERPL:
case EVENT_CTCPTIMERPLBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_CTCPTIMEREQ:
case EVENT_CTCPTIMEREQBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_CTCPPINGRPL:
case EVENT_CTCPPINGRPLBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_CTCPPINGREQ:
case EVENT_CTCPPINGREQBC:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 1, cmdparams->source->name);
break;
case EVENT_DCCSEND:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_DCCCHAT:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_DCCCHATMSG:
- ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ ret = execute_perl(mod_ptr, mod_ptr->pm->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
break;
case EVENT_ADDBAN:
case EVENT_DELBAN:
@@ -423,7 +423,7 @@
mod->info->name = strndup(SvPV_nolen (ST (0)), sv_len(ST (0)));
mod->info->version = strndup(SvPV_nolen (ST (1)), sv_len(ST (1)));
mod->info->description = strndup(SvPV_nolen (ST (2)), sv_len(ST(2)));
-
+ mod->pm->registered = 1;
XSRETURN_UV (PTR2UV (mod));
}
@@ -485,13 +485,13 @@
nlog(LOG_WARNING, "Usage: NeoStats:Internal:unhook_event(hook)");
} else {
evt = (int) SvIV (ST(0));
- if (mod->event_list && mod->event_list[evt]->pe) {
- SvREFCNT_dec(mod->event_list[evt]->pe->callback);
- SvREFCNT_dec(mod->event_list[evt]->pe->userdata);
- ns_free(mod->event_list[evt]->pe);
- ns_free(mod->event_list[evt]);
+ if (mod->pm->event_list && mod->pm->event_list[evt]->pe) {
+ SvREFCNT_dec(mod->pm->event_list[evt]->pe->callback);
+ SvREFCNT_dec(mod->pm->event_list[evt]->pe->userdata);
+ ns_free(mod->pm->event_list[evt]->pe);
+ ns_free(mod->pm->event_list[evt]);
+ mod->pm->event_list[evt] = NULL;
}
- DeleteEvent(evt);
}
XSRETURN_EMPTY;
}
@@ -738,7 +738,7 @@
XSRETURN_UV(add_bot_cmd(bot->botcmds, bc));
} else {
- nlog(LOG_WARNING, "XS_NeoStats_AddBot: Bot %s is not valid", ST(0));
+ nlog(LOG_WARNING, "XS_NeoStats_AddBot: Bot %s is not valid", SvPV_nolen(ST(0)));
}
}
@@ -1386,6 +1386,8 @@
xs_init (pTHX)
{
HV *stash;
+ Module *mod;
+ mod = GET_CUR_MODULE();
/* This one allows dynamic loading of perl modules in perl
scripts by the 'use perlmod;' construction */
newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
@@ -1521,6 +1523,9 @@
newCONSTSUB (stash, "NS_SUCCESS", newSViv (NS_SUCCESS));
newCONSTSUB (stash, "NS_FAILURE", newSViv (NS_FAILURE));
+ if (mod->pm->extninit) {
+ mod->pm->extninit();
+ }
}
int
@@ -1530,17 +1535,14 @@
return NS_SUCCESS;
}
-
-Module *load_perlmodule (const char *filename, Client *u)
+Module *load_perlfiles (const char *filename, Module *mod, perl_xs_init init_func)
{
char *perl_args[] = { "", "-e", "0", "-w" };
- CmdParams *cmd;
+
const char perl_definitions[] = {
#include "neostats.pm.h"
};
- Module *mod;
-
-
+
#ifdef WIN32
static HINSTANCE lib = NULL;
@@ -1551,18 +1553,16 @@
nlog(LOG_WARNING, "Warning, Could not load ActivePerl. Please see documentation");
return NULL;
}
- FreeLibrary (lib);
}
#endif
- mod = ns_calloc(sizeof(Module));
+
mod->pm = ns_calloc(sizeof(PerlModInfo));
- mod->info = ns_calloc(sizeof(ModuleInfo));
- mod->type = MOD_TYPE_PERL;
+ mod->pm->registered = 0;
+ mod->pm->extninit = init_func;
+
strlcpy(mod->pm->filename, filename, MAXPATH);
- /* this is a temp solution till we get fully loaded. Its Bad */
- mod->info->name = ns_malloc(strlen("NeoStats")+1);
- ircsnprintf((char *)mod->info->name, strlen("NeoStats")+1, "NeoStats");
+
PL_perl_destruct_level = 1;
mod->pm->my_perl = perl_alloc ();
@@ -1570,17 +1570,67 @@
PERL_SET_CONTEXT((PMI *)mod->pm->my_perl);
perl_construct (mod->pm->my_perl);
PL_perl_destruct_level = 1;
+ SET_RUN_LEVEL(mod);
perl_parse (mod->pm->my_perl, xs_init, 4, perl_args, NULL);
/*
Now initialising the perl interpreter by loading the
perl_definition array.
*/
eval_pv (perl_definitions, TRUE);
+ RESET_RUN_LEVEL();
+ return mod;
+}
+
+int load_perlextension(const char *filename, perl_xs_init init_func, Client *u)
+{
+ Module *mod;
+
+ mod = GET_CUR_MODULE();
+ if (!mod) {
+ nlog(LOG_WARNING, "Trying to laod a Perl Extension %s in the core? No No", filename);
+ return NS_FAILURE;
+ }
+
+ mod = load_perlfiles((const char *)filename, mod, init_func);
+
+ SET_RUN_LEVEL(mod);
+ if (!execute_perl (mod, sv_2mortal (newSVpv ("NeoStats::Embed::loadextension", 0)),
+ 1, (char *)filename)) {
+ /* if we are here, check that pm->mod->description has something, otherwise the script didnt register */
+ if (!mod->pm->registered) {
+ load_module_error(u, filename, __("Perl extension didn't register.", u));
+ unload_perlextension(mod);
+ return NS_FAILURE;
+ }
+ /* it loaded ok */
+ } else {
+ load_module_error(u, filename, __("Errors in Perl extension", u));
+ unload_perlextension(mod);
+ return NS_FAILURE;
+ }
+ return NS_SUCCESS;
+
+
+}
+Module *load_perlmodule (const char *filename, Client *u)
+{
+ Module *mod;
+ CmdParams *cmd;
+
+ mod = ns_calloc(sizeof(Module));
+ mod->info = ns_calloc(sizeof(ModuleInfo));
+ /* this is a temp solution till we get fully loaded. Its Bad */
+ mod->info->name = ns_malloc(strlen("NeoStats")+1);
+ ircsnprintf((char *)mod->info->name, strlen("NeoStats")+1, "NeoStats");
+
+ mod = load_perlfiles((const char *)filename, mod, NULL);
+
+ mod->type = MOD_TYPE_PERL;
SET_RUN_LEVEL(mod);
if (!execute_perl (mod, sv_2mortal (newSVpv ("NeoStats::Embed::load", 0)),
1, (char *)filename)) {
- /* if we are here, check that pm->mod->info has something, otherwise the script didnt register */
- if (!mod->info->name[0]) {
+ /* if we are here, check that pm->mod->description has something, otherwise the script didnt register */
+ if (!mod->pm->registered) {
load_module_error(u, filename, __("Perl Module didn't register.", u));
unload_perlmod(mod);
free(mod);
@@ -1627,6 +1677,13 @@
}
}
+void PerlExtensionFini(Module *mod)
+{
+ if (IsModuleSynched(mod) ) {
+ execute_perl(mod, sv_2mortal (newSVpv ("NeoStats::Embed::unloadextension", 0)), 1, mod->pm->filename);
+ }
+}
+
void unload_perlmod(Module *mod)
{
PERL_SET_CONTEXT((PMI *)mod->pm->my_perl);
@@ -1651,3 +1708,19 @@
free(mod->pm);
}
+void unload_perlextension(Module *mod)
+{
+ PERL_SET_CONTEXT((PMI *)mod->pm->my_perl);
+ /* because segv handler doesn't handle perl well yet */
+// RESET_RUN_LEVEL()
+ PL_perl_destruct_level = 1;
+ perl_destruct ((PMI *)mod->pm->my_perl);
+
+ perl_free ((PMI *)mod->pm->my_perl);
+
+ if (mod->pm->event_list) {
+ free(mod->pm->event_list);
+ mod->pm->event_list = NULL;
+ }
+ free(mod->pm);
+}