more perl updates, starting on event subsystem

This commit is contained in:
Fish 2005-07-06 15:25:31 +00:00
parent a75a84f20f
commit 24ea3e0560
6 changed files with 127 additions and 46 deletions

View file

@ -1,4 +1,7 @@
sub pkg_load { sub pkg_load {
print "hello world\n"; print "hello world\n";
} }
pkg_load();
NeoStats::register( "Test Script 1", "1.0",
"Test Script 1 description" );

View file

@ -3,4 +3,6 @@ sub pkg_load {
print "this is my stupid message\n"; print "this is my stupid message\n";
NeoStats::print("and this is a neostats message\n"); NeoStats::print("and this is a neostats message\n");
} }
NeoStats::register( "Test Script 2", "2.0",
"Test Script 2 Description" );
pkg_load(); pkg_load();

View file

@ -919,6 +919,14 @@ typedef struct ModuleInfo {
typedef int (*mod_auth) ( Client *u ); typedef int (*mod_auth) ( Client *u );
typedef int (*userauthfunc) ( Client *u ); typedef int (*userauthfunc) ( Client *u );
typedef enum MOD_TYPE {
/* standard C Modules */
MOD_STANDARD = 1,
/* Perl Modules */
MOD_PERL
} MOD_TYPE;
/** @brief Module structure /** @brief Module structure
* *
*/ */
@ -932,6 +940,7 @@ typedef struct _Module {
unsigned int insynch; unsigned int insynch;
unsigned int synched; unsigned int synched;
unsigned int error; unsigned int error;
MOD_TYPE modtype;
}_Module; }_Module;
EXPORTVAR extern Module *RunModule[10]; EXPORTVAR extern Module *RunModule[10];

View file

@ -53,7 +53,7 @@ use Symbol();
$pkg_info->{shutdown} = $callback; $pkg_info->{shutdown} = $callback;
$pkg_info->{gui_entry} = $pkg_info->{gui_entry} =
NeoStats::Internal::register( $name, $version, $description, $filename ); NeoStats::Internal::register( $name, $version, $description);
# keep with old behavior # keep with old behavior
return (); return ();
@ -435,7 +435,6 @@ $SIG{__WARN__} = sub {
} }
sub load { sub load {
NeoStats::print('haha');
my $file = expand_homedir( shift @_ ); my $file = expand_homedir( shift @_ );
my $package = file2pkg( $file ); my $package = file2pkg( $file );

View file

@ -324,6 +324,7 @@ load_module (const char *modfilename, Client * u)
dlog(DEBUG1, "Module description: %s", infoptr->description); dlog(DEBUG1, "Module description: %s", infoptr->description);
mod_ptr->info = infoptr; mod_ptr->info = infoptr;
mod_ptr->handle = handle; mod_ptr->handle = handle;
mod_ptr->modtype = MOD_STANDARD;
/* Extract pointer to event list */ /* Extract pointer to event list */
eventlistptr = ns_dlsym (handle, "module_events"); eventlistptr = ns_dlsym (handle, "module_events");
if(eventlistptr) { if(eventlistptr) {

View file

@ -32,7 +32,7 @@
#include <dirent.h> #include <dirent.h>
static int perl_load_file (char *script_name); static int perl_load_file (char *script_name);
static void free_perlmod(Module *mod);
@ -92,7 +92,7 @@ list_t *perlmods;
typedef struct { typedef struct {
char filename[MAXPATH]; char filename[MAXPATH];
ModuleInfo *modinfo; Module *mod;
PerlInterpreter *my_perl; PerlInterpreter *my_perl;
} PerlModInfo; } PerlModInfo;
@ -112,6 +112,7 @@ execute_perl (PerlModInfo *pm, SV * function, char *args)
dSP; dSP;
ENTER; ENTER;
SAVETMPS; SAVETMPS;
SET_RUN_LEVEL(pm->mod);
PERL_SET_CONTEXT(pm->my_perl); PERL_SET_CONTEXT(pm->my_perl);
PUSHMARK (SP); PUSHMARK (SP);
@ -135,7 +136,7 @@ execute_perl (PerlModInfo *pm, SV * function, char *args)
PUTBACK; PUTBACK;
FREETMPS; FREETMPS;
LEAVE; LEAVE;
RESET_RUN_LEVEL();
return ret_value; return ret_value;
} }
@ -350,34 +351,45 @@ command_cb (char *word[], char *word_eol[], void *userdata)
/* custom IRC perl functions for scripting */ /* custom IRC perl functions for scripting */
/* NeoStats::Internal::register (scriptname, version, desc, shutdowncallback, filename) /* NeoStats::Internal::register (scriptname, version, desc)
* *
*/ */
#endif
static static
XS (XS_Xchat_register) XS (XS_NeoStats_register)
{ {
char *name, *version, *desc, *filename; char *name, *version, *desc;
void *gui_entry; Module *mod;
dXSARGS; dXSARGS;
if (items != 4) {
xchat_printf (ph,
"Usage: NeoStats::Internal::register(scriptname, version, desc, filename)"); if (items != 3) {
nlog(LOG_WARNING, "Usage: NeoStats::Internal::register(scriptname, version, desc)");
} else { } else {
mod = GET_CUR_MODULE();
if (!mod) {
nlog(LOG_WARNING, "Current Mod Stack for Perl Mods is screwed");
XSRETURN_EMPTY;
}
name = SvPV_nolen (ST (0)); name = SvPV_nolen (ST (0));
version = SvPV_nolen (ST (1)); version = SvPV_nolen (ST (1));
desc = SvPV_nolen (ST (2)); desc = SvPV_nolen (ST (2));
filename = SvPV_nolen (ST (3)); mod->info->name = os_malloc(strlen(name)+1);
strlcpy((char *)mod->info->name, name, strlen(name)+1);
gui_entry = xchat_plugingui_add (ph, filename, name, mod->info->description = os_malloc(strlen(desc)+1);
desc, version, NULL); strlcpy((char *)mod->info->description, desc, strlen(desc)+1);
XSRETURN_UV (PTR2UV (gui_entry)); mod->info->version = os_malloc(strlen(version)+1);
strlcpy((char *)mod->info->version, version, strlen(version)+1);
XSRETURN_UV (PTR2UV (mod));
} }
} }
#endif
/* NeoStats::debug(output) */ /* NeoStats::debug(output) */
static static
XS (XS_NeoStats_debug) XS (XS_NeoStats_debug)
@ -697,37 +709,67 @@ XS (XS_Xchat_get_list)
static void static void
xs_init (pTHX) xs_init (pTHX)
{ {
#if 0
HV *stash; HV *stash;
#endif
/* This one allows dynamic loading of perl modules in perl /* This one allows dynamic loading of perl modules in perl
scripts by the 'use perlmod;' construction */ scripts by the 'use perlmod;' construction */
newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
/* load up all the custom IRC perl functions */ /* load up all the custom IRC perl functions */
newXS ("NeoStats::Internal::debug", XS_NeoStats_debug, __FILE__); newXS ("NeoStats::Internal::debug", XS_NeoStats_debug, __FILE__);
#if 0 newXS ("NeoStats::Internal::register", XS_NeoStats_register, __FILE__);
stash = get_hv ("NeoStats::", TRUE); stash = get_hv ("NeoStats::", TRUE);
if (stash == NULL) { if (stash == NULL) {
exit (1); exit (1);
} }
newCONSTSUB (stash, "EVENT_NULL", newSViv (EVENT_NULL));
newCONSTSUB (stash, "EVENT_MODULELOAD", newSViv (EVENT_MODULELOAD));
newCONSTSUB (stash, "EVENT_MODULEUNLOAD", newSViv (EVENT_MODULEUNLOAD));
newCONSTSUB (stash, "EVENT_SERVER", newSViv (EVENT_SERVER));
newCONSTSUB (stash, "EVENT_SQUIT", newSViv (EVENT_SQUIT));
newCONSTSUB (stash, "EVENT_PING", newSViv (EVENT_PING));
newCONSTSUB (stash, "EVENT_PONG", newSViv (EVENT_PONG));
newCONSTSUB (stash, "EVENT_SIGNON", newSViv (EVENT_SIGNON));
newCONSTSUB (stash, "EVENT_QUIT", newSViv (EVENT_QUIT));
newCONSTSUB (stash, "EVENT_NICKIP", newSViv (EVENT_NICKIP));
newCONSTSUB (stash, "EVENT_KILL", newSViv (EVENT_KILL));
newCONSTSUB (stash, "EVENT_GLOBALKILL", newSViv (EVENT_GLOBALKILL));
newCONSTSUB (stash, "EVENT_LOCALKILL", newSViv (EVENT_LOCALKILL));
newCONSTSUB (stash, "EVENT_SERVERKILL", newSViv (EVENT_SERVERKILL));
newCONSTSUB (stash, "EVENT_BOTKILL", newSViv (EVENT_BOTKILL));
newCONSTSUB (stash, "EVENT_NICK", newSViv (EVENT_NICK));
newCONSTSUB (stash, "EVENT_AWAY", newSViv (EVENT_AWAY));
newCONSTSUB (stash, "EVENT_UMODE", newSViv (EVENT_SMODE));
newCONSTSUB (stash, "EVENT_NEWCHAN", newSViv (EVENT_NEWCHAN));
newCONSTSUB (stash, "EVENT_DELCHAN", newSViv (EVENT_DELCHAN));
newCONSTSUB (stash, "EVENT_JOIN", newSViv (EVENT_JOIN));
newCONSTSUB (stash, "EVENT_PART", newSViv (EVENT_PART));
newCONSTSUB (stash, "EVENT_PARTBOT", newSViv (EVENT_PARTBOT));
newCONSTSUB (stash, "EVENT_EMPTYCHAN", newSViv (EVENT_EMPTYCHAN));
newCONSTSUB (stash, "EVENT_KICK", newSViv (EVENT_KICK));
newCONSTSUB (stash, "EVENT_KICKBOT", newSViv (EVENT_KICKBOT));
newCONSTSUB (stash, "EVENT_TOPIC", newSViv (EVENT_TOPIC));
newCONSTSUB (stash, "EVENT_CMODE", newSViv (EVENT_CMODE));
newCONSTSUB (stash, "EVENT_PRIVATE", newSViv (EVENT_PRIVATE));
newCONSTSUB (stash, "EVENT_NOTICE", newSViv (EVENT_NOTICE));
newCONSTSUB (stash, "EVENT_CPRIVATE", newSViv (EVENT_CPRIVATE));
newCONSTSUB (stash, "EVENT_CNOTICE", newSViv (EVENT_CNOTICE));
newCONSTSUB (stash, "EVENT_GLOBOPS", newSViv (EVENT_GLOBOPS));
newCONSTSUB (stash, "EVENT_CHATOPS", newSViv (EVENT_CHATOPS));
newCONSTSUB (stash, "EVENT_WALLOPS", newSViv (EVENT_WALLOPS));
newCONSTSUB (stash, "EVENT_CTCPVERSIONRPL", newSViv (EVENT_CTCPVERSIONRPL));
newCONSTSUB (stash, "EVENT_CTCPVERSIONREQ", newSViv (EVENT_CTCPVERSIONREQ));
newCONSTSUB (stash, "EVENT_CTCPFINGERRPL", newSViv (EVENT_CTCPFINGERRPL));
newCONSTSUB (stash, "EVENT_CTCPFINGERREQ", newSViv (EVENT_CTCPFINGERREQ));
newCONSTSUB (stash, "EVENT_CTCPACTIONREQ", newSViv (EVENT_CTCPACTIONREQ));
newCONSTSUB (stash, "EVENT_CTCPTIMERPL", newSViv (EVENT_CTCPTIMERPL));
newCONSTSUB (stash, "EVENT_CTCPTIMEREQ", newSViv (EVENT_CTCPTIMEREQ));
newCONSTSUB (stash, "EVENT_CTCPPINGRPL", newSViv (EVENT_CTCPPINGRPL));
newCONSTSUB (stash, "EVENT_CTCPPINGREQ", newSViv (EVENT_CTCPPINGREQ));
newCONSTSUB (stash, "EVENT_DCCSEND", newSViv (EVENT_DCCSEND));
newCONSTSUB (stash, "EVENT_DCCCHAT", newSViv (EVENT_DCCCHAT));
newCONSTSUB (stash, "EVENT_DCCCHATMSG", newSViv (EVENT_DCCCHATMSG));
newCONSTSUB (stash, "EVENT_ADDBAN", newSViv (EVENT_ADDBAN));
newCONSTSUB (stash, "EVENT_DELBAN", newSViv (EVENT_DELBAN));
newCONSTSUB (stash, "PRI_HIGHEST", newSViv (XCHAT_PRI_HIGHEST));
newCONSTSUB (stash, "PRI_HIGH", newSViv (XCHAT_PRI_HIGH));
newCONSTSUB (stash, "PRI_NORM", newSViv (XCHAT_PRI_NORM));
newCONSTSUB (stash, "PRI_LOW", newSViv (XCHAT_PRI_LOW));
newCONSTSUB (stash, "PRI_LOWEST", newSViv (XCHAT_PRI_LOWEST));
newCONSTSUB (stash, "EAT_NONE", newSViv (XCHAT_EAT_NONE));
newCONSTSUB (stash, "EAT_XCHAT", newSViv (XCHAT_EAT_XCHAT));
newCONSTSUB (stash, "EAT_PLUGIN", newSViv (XCHAT_EAT_PLUGIN));
newCONSTSUB (stash, "EAT_ALL", newSViv (XCHAT_EAT_ALL));
newCONSTSUB (stash, "FD_READ", newSViv (XCHAT_FD_READ));
newCONSTSUB (stash, "FD_WRITE", newSViv (XCHAT_FD_WRITE));
newCONSTSUB (stash, "FD_EXCEPTION", newSViv (XCHAT_FD_EXCEPTION));
newCONSTSUB (stash, "FD_NOTSOCKET", newSViv (XCHAT_FD_NOTSOCKET));
newCONSTSUB (stash, "KEEP", newSViv (1));
newCONSTSUB (stash, "REMOVE", newSViv (0));
#endif
} }
int int
@ -772,7 +814,10 @@ perl_load_file (char *filename)
#endif #endif
pm = os_malloc(sizeof(PerlModInfo)); pm = os_malloc(sizeof(PerlModInfo));
pm->modinfo = os_malloc(sizeof(ModuleInfo)); pm->mod = os_malloc(sizeof(Module));
pm->mod->info = os_malloc(sizeof(ModuleInfo));
pm->mod->modtype = MOD_PERL;
pm->mod->info->name = NULL;
strlcpy(pm->filename, filename, MAXPATH); strlcpy(pm->filename, filename, MAXPATH);
pm->my_perl = perl_alloc (); pm->my_perl = perl_alloc ();
PL_perl_destruct_level = 1; PL_perl_destruct_level = 1;
@ -784,19 +829,27 @@ perl_load_file (char *filename)
perl_definition array. perl_definition array.
*/ */
eval_pv (perl_definitions, TRUE); eval_pv (perl_definitions, TRUE);
if (!execute_perl (pm, sv_2mortal (newSVpv ("NeoStats::Embed::load", 0)), if (!execute_perl (pm, sv_2mortal (newSVpv ("NeoStats::Embed::load", 0)),
filename)) { filename)) {
/* XXX if we are here, check that pm->mod->info has something, otherwise the script didnt register */
if (!pm->mod->info->name[0]) {
nlog(LOG_WARNING, "Perl Module %s didn't register. Unloading", filename);
perl_destruct (pm->my_perl);
perl_free (pm->my_perl);
free_perlmod(pm->mod);
free(pm);
return NS_FAILURE;
}
/* it loaded ok */ /* it loaded ok */
nlog(LOG_NORMAL, "Loaded Perl Module %s", filename); nlog(LOG_NORMAL, "Loaded Perl Module %s (%s)", pm->mod->info->name, pm->mod->info->version);
} else { } else {
nlog(LOG_WARNING, "Errors in Perl Module %s", filename); nlog(LOG_WARNING, "Errors in Perl Module %s", filename);
perl_destruct (pm->my_perl); perl_destruct (pm->my_perl);
perl_free (pm->my_perl); perl_free (pm->my_perl);
free(pm->modinfo); free_perlmod(pm->mod);
free(pm); free(pm);
return NS_FAILURE;
} }
node = lnode_create(pm); node = lnode_create(pm);
list_append(perlmods, node); list_append(perlmods, node);
return NS_SUCCESS; return NS_SUCCESS;
@ -813,7 +866,7 @@ FiniPerl (void)
execute_perl (pm, sv_2mortal (newSVpv ("NeoStats::Embed::unload", 0)), pm->filename); execute_perl (pm, sv_2mortal (newSVpv ("NeoStats::Embed::unload", 0)), pm->filename);
perl_destruct (pm->my_perl); perl_destruct (pm->my_perl);
perl_free (pm->my_perl); perl_free (pm->my_perl);
free(pm->modinfo); free_perlmod(pm->mod);
free(pm); free(pm);
node = list_next(perlmods, node); node = list_next(perlmods, node);
} }
@ -825,8 +878,22 @@ void ns_cmd_modperlist(CmdParams *cmd) {
node = list_first(perlmods); node = list_first(perlmods);
while (node != NULL) { while (node != NULL) {
pm = lnode_get(node); pm = lnode_get(node);
irc_prefmsg(ns_botptr, cmd->source,__("Perl Module: %s (%s)", cmd->source), pm->filename, pm->modinfo->version); irc_prefmsg(ns_botptr, cmd->source,__("Perl Module: %s (%s)", cmd->source), pm->mod->info->name, pm->mod->info->version);
irc_prefmsg(ns_botptr, cmd->source," : %s", pm->modinfo->description); irc_prefmsg(ns_botptr, cmd->source," : %s", pm->mod->info->description);
node = list_next(perlmods, node); node = list_next(perlmods, node);
} }
} }
static void free_perlmod(Module *mod) {
free((void *)mod->info->name);
free((void *)mod->info->description);
free((void *)mod->info->version);
free(mod->info);
free(mod);
}