Author: Fish
Date: Fri Jul 8 20:56:49 2005
New Revision: 2656
Added:
trunk/modules/perltest/
trunk/modules/perltest/test.pl
Modified:
trunk/include/neostats.h
trunk/include/perlmod.h
trunk/src/NeoStats.pm
trunk/src/modules.c
trunk/src/perl.c
Log:
Perl Module Event Handlers now operational - And the beer is good today
Modified: trunk/include/neostats.h
==============================================================================
--- trunk/include/neostats.h (original)
+++ trunk/include/neostats.h Fri Jul 8 20:56:49 2005
@@ -841,6 +841,12 @@
#define EVENT_FLAG_EXCLUDE_ME 0x00000008 /* Event excludes neostats bots and servers */
#define EVENT_FLAG_EXCLUDE_MODME 0x00000010 /* Event excludes module bots */
+#ifdef PERL
+/** @breif Forward Decl of Perl Events
+ */
+struct PerlEvent;
+#endif
+
/** @brief Event function types
*
*/
@@ -854,6 +860,9 @@
Event event;
event_handler handler;
unsigned int flags;
+#ifdef USE_PERL
+ struct PerlEvent *pe;
+#endif
}ModuleEvent;
typedef int ModuleProtocol;
Modified: trunk/include/perlmod.h
==============================================================================
--- trunk/include/perlmod.h (original)
+++ trunk/include/perlmod.h Fri Jul 8 20:56:49 2005
@@ -33,6 +33,12 @@
#include <XSUB.h>
+typedef struct PerlEvent {
+ SV *callback;
+ SV *userdata;
+ int options;
+} PerlEvent;
+
typedef struct PerlModInfo {
char filename[MAXPATH];
PerlInterpreter *my_perl;
Added: trunk/modules/perltest/test.pl
==============================================================================
--- (empty file)
+++ trunk/modules/perltest/test.pl Fri Jul 8 20:56:49 2005
@@ -0,0 +1,319 @@
+# NeoStats Perl Module to test Perl Interface
+#
+# Copyright 2004 Justin Hammond
+#
+# You can use this module as a template to code your own. I'll try to describe a lot of it
+# for you.
+
+# First thing that you must ensure happens (ie, first command) is to register this script
+# Using the following command:
+
+NeoStats::register( "Test", "1.0", "Test Script 1 description" );
+
+# Events make up the core communications of NeoStats, here you register the events your
+# Interested in, and the function to call. A optional third arguement ($options) allows you
+# to specify optional items such as:
+# Event Flags:
+# These Determine under what circumstances the event will be called
+# Specify as $option->{flags} = <EVENT_FLAG_???>
+# User Data:
+# Not Currently implemented
+
+NeoStats::hook_event(NeoStats::EVENT_MODULELOAD, "event_moduleload");
+NeoStats::hook_event(NeoStats::EVENT_MODULEUNLOAD, "event_moduleunload");
+NeoStats::hook_event(NeoStats::EVENT_SERVER, "event_server");
+NeoStats::hook_event(NeoStats::EVENT_SQUIT, "event_squit");
+NeoStats::hook_event(NeoStats::EVENT_PING, "event_ping");
+NeoStats::hook_event(NeoStats::EVENT_PONG, "event_pong");
+NeoStats::hook_event(NeoStats::EVENT_SIGNON, "event_signon");
+NeoStats::hook_event(NeoStats::EVENT_QUIT, "event_quit");
+NeoStats::hook_event(NeoStats::EVENT_NICKIP, "event_nickip");
+NeoStats::hook_event(NeoStats::EVENT_KILL, "event_kill");
+NeoStats::hook_event(NeoStats::EVENT_GLOBALKILL, "event_globalkill");
+NeoStats::hook_event(NeoStats::EVENT_LOCALKILL, "event_localkill");
+NeoStats::hook_event(NeoStats::EVENT_SERVERKILL, "event_serverkill");
+NeoStats::hook_event(NeoStats::EVENT_BOTKILL, "event_botkill");
+NeoStats::hook_event(NeoStats::EVENT_NICK, "event_nick");
+NeoStats::hook_event(NeoStats::EVENT_AWAY, "event_away");
+NeoStats::hook_event(NeoStats::EVENT_UMODE, "event_umode");
+NeoStats::hook_event(NeoStats::EVENT_SMODE, "event_smode");
+NeoStats::hook_event(NeoStats::EVENT_NEWCHAN, "event_newchan");
+NeoStats::hook_event(NeoStats::EVENT_DELCHAN, "event_delchan");
+NeoStats::hook_event(NeoStats::EVENT_JOIN, "event_join");
+NeoStats::hook_event(NeoStats::EVENT_PART, "event_part");
+NeoStats::hook_event(NeoStats::EVENT_PARTBOT, "event_partbot");
+NeoStats::hook_event(NeoStats::EVENT_EMPTYCHAN, "event_emptychan");
+NeoStats::hook_event(NeoStats::EVENT_KICK, "event_kick");
+NeoStats::hook_event(NeoStats::EVENT_KICKBOT, "event_kickbot");
+NeoStats::hook_event(NeoStats::EVENT_TOPIC, "event_topic");
+NeoStats::hook_event(NeoStats::EVENT_CMODE, "event_cmode");
+NeoStats::hook_event(NeoStats::EVENT_PRIVATE, "event_private");
+NeoStats::hook_event(NeoStats::EVENT_NOTICE, "event_notice");
+NeoStats::hook_event(NeoStats::EVENT_CPRIVATE, "event_cprivate");
+NeoStats::hook_event(NeoStats::EVENT_CNOTICE, "event_cnotice");
+NeoStats::hook_event(NeoStats::EVENT_GLOBOPS, "event_globops");
+NeoStats::hook_event(NeoStats::EVENT_CHATOPS, "event_chatops");
+NeoStats::hook_event(NeoStats::EVENT_WALLOPS, "event_wallops");
+NeoStats::hook_event(NeoStats::EVENT_CTCPVERSIONRPL, "event_ctcpversionrpl");
+NeoStats::hook_event(NeoStats::EVENT_CTCPVERSIONREQ, "event_ctcpversionreq");
+NeoStats::hook_event(NeoStats::EVENT_CTCPFINGERRPL, "event_ctcpfingerrpl");
+NeoStats::hook_event(NeoStats::EVENT_CTCPFINGERREQ, "event_ctcpfingerreq");
+NeoStats::hook_event(NeoStats::EVENT_CTCPACTIONREQ, "event_ctcpactionreq");
+NeoStats::hook_event(NeoStats::EVENT_CTCPTIMERPL, "event_ctcptimerpl");
+NeoStats::hook_event(NeoStats::EVENT_CTCPTIMEREQ, "event_ctcptimereq");
+NeoStats::hook_event(NeoStats::EVENT_CTCPPINGRPL, "event_ctcppingrpl");
+NeoStats::hook_event(NeoStats::EVENT_CTCPPINGREQ, "event_ctcppingreq");
+NeoStats::hook_event(NeoStats::EVENT_DCCSEND, "event_dccsend");
+NeoStats::hook_event(NeoStats::EVENT_DCCCHAT, "event_dccchat");
+NeoStats::hook_event(NeoStats::EVENT_DCCCHATMSG, "event_dccchatmsg");
+NeoStats::hook_event(NeoStats::EVENT_ADDBAN, "event_addban");
+NeoStats::hook_event(NeoStats::EVENT_DELBAN, "event_delban");
+
+sub event_moduleload {
+ my ($param1) = @_;
+ NeoStats::print("New Module Loaded: $param1");
+}
+
+sub event_moduleunload {
+ my ($param1) = @_;
+ NeoStats::print("Module Unloaded: $param1");
+}
+
+sub event_server {
+ my ($test) = @_;
+ NeoStats::print "New Server $test";
+}
+
+sub event_squit {
+ my ($server, $msg) = @_;
+ NeoStats::print "Server $server Squit: $msg";
+}
+
+sub event_ping {
+ my ($source) = @_;
+ NeoStats::print "Ping $source";
+}
+
+sub event_pong {
+ my ($source) = @_;
+ NeoStats::print "Pong $source";
+}
+
+sub event_signon {
+ my ($source) = @_;
+ NeoStats::print "Signon $source";
+}
+
+sub event_quit {
+ my ($source, $msg) = @_;
+ NeoStats::print "Quit $source: $msg";
+}
+
+sub event_nickip {
+ my ($source) = @_;
+ NeoStats::print "NickIP $source";
+}
+
+sub event_kill {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "KILL $target by $source: $msg";
+}
+
+sub event_globalkill {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "GLOBALKILL $target by $source: $msg";
+}
+
+sub event_localkill {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "LOCALKILL $target by $source: $msg";
+}
+
+sub event_serverkill {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "SEVERKILL $target by $source: $msg";
+}
+
+sub event_botkill {
+ my ($target, $msg) = @_;
+ NeoStats::print "BOTKILL $target: $msg";
+}
+
+sub event_nick {
+ my ($source, $target) = @_;
+ NeoStats::print "NICKChange $source: $target";
+}
+
+sub event_away {
+ my ($source) = @_;
+ NeoStats::print "AwayChange $source";
+}
+
+sub event_umode {
+ my ($source, $mode) = @_;
+ NeoStats::print "UMODE $source, $mode";
+}
+
+sub event_smode {
+ my ($source, $mode) = @_;
+ NeoStats::print "SMODE $source, $mode";
+}
+
+sub event_newchan {
+ my ($channel) = @_;
+ NeoStats::print "NewChan $channel";
+}
+
+sub event_delchan {
+ my ($channel) = @_;
+ NeoStats::print "DelChan $channel";
+}
+
+sub event_join {
+ my ($channel, $source) = @_;
+ NeoStats::print "Join $channel: $source";
+}
+
+sub event_part {
+ my ($channel, $source, $msg) = @_;
+ NeoStats::print "Part $channel: $source: $msg";
+}
+
+sub event_partbot {
+ my ($channel, $source, $msg) = @_;
+ NeoStats::print "Partbot $channel: $source: $msg";
+}
+
+sub event_emptychan {
+ my ($channel, $source, $bot, $msg) = @_;
+ NeoStats::print "Empty $channel $source $bot: $msg";
+}
+
+sub event_kick {
+ my ($channel, $source, $target, $msg) = @_;
+ NeoStats::print "Kick $channel $source $target: $msg";
+}
+
+sub event_kickbot {
+ my ($channel, $source, $target, $msg) = @_;
+ NeoStats::print "Kickbot $channel $source $target: $msg";
+}
+
+sub event_topic {
+ my ($channel, $source) = @_;
+ NeoStats::print "Topic $channel $source";
+}
+
+sub event_cmode {
+ NeoStats::print "ToDO";
+}
+
+sub event_private {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "Privmsg $source $target: $msg";
+}
+
+sub event_notice {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "NOTICE $source $target: $msg";
+}
+
+sub event_cprivate {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "CPRIVATE $source $target: $msg";
+}
+
+sub event_cnotice {
+ my ($source, $target, $msg) = @_;
+ NeoStats::print "CNOTICE $source $target: $msg";
+}
+
+sub event_globops {
+ my ($source, $msg) = @_;
+ NeoStats::print "GLOBOPS $source $msg";
+}
+
+sub event_chatops {
+ my ($source, $msg) = @_;
+ NeoStats::print "CHATOPS $source: $msg";
+}
+
+sub event_wallops {
+ my ($source, $msg) = @_;
+ NeoStats::print "WALLOPS $source: $msg";
+}
+
+sub event_ctcpversionrpl {
+ my ($source, $msg) = @_;
+ NeoStats::print "CTCPVERSIONRPL $source: $msg";
+}
+
+sub event_ctcpversionreq {
+ my ($source) = @_;
+ NeoStats::print "CTCPVERSIONREQ $source";
+}
+
+sub event_ctcpfingerrpl {
+ my ($source, $msg) = @_;
+ NeoStats::print "CTCPFINGERRPL $source: $msg";
+}
+
+sub event_ctcpfingerreq {
+ my ($source) = @_;
+ NeoStats::print "CTCPFINGERREQ $source";
+}
+
+sub event_ctcpactionreq {
+ my ($source) = @_;
+ NeoStats::print "CTCPACTIONREQ $source";
+}
+
+sub event_ctcptimerpl {
+ my ($source, $msg) = @_;
+ NeoStats::print "CTCPTIMERPL $source: $msg";
+}
+
+sub event_ctcptimereq {
+ my ($source) = @_;
+ NeoStats::print "CTCPTIMEREQ $source";
+}
+
+sub event_ctcppingrpl {
+ my ($source, $msg) = @_;
+ NeoStats::print "CTCPPINGRPL $source: $msg";
+}
+
+sub event_ctcppingreq {
+ my ($source) = @_;
+ NeoStats::print "CTCPPINGREQ $source";
+}
+
+sub event_dccsend {
+ my ($source, $msg) = @_;
+ NeoStats::print "DCCSEND $source: $msg";
+}
+
+sub event_dccchat {
+ my ($source, $msg) = @_;
+ NeoStats::print "DCCCHAT $source: $msg";
+}
+
+sub event_dccmsg {
+ my ($source, $msg) = @_;
+ NeoStats::print "DCCMSG $source: $msg";
+}
+
+sub event_addban {
+ NeoStats::print "AddBan";
+}
+
+sub event_delban {
+ NeoStats::print "DelBan";
+}
+
+
+
+
+
+
+
Modified: trunk/src/NeoStats.pm
==============================================================================
--- trunk/src/NeoStats.pm (original)
+++ trunk/src/NeoStats.pm Fri Jul 8 20:56:49 2005
@@ -17,12 +17,12 @@
qw(find_context get_context set_context),
qw(get_info get_prefs emit_print nickcmp),
qw(get_list context_info strip_code),
- qw(PRI_HIGHEST PRI_HIGH PRI_NORM PRI_LOW),
+ qw(EVENT_MODULELOAD EVENT_MODULEUNLOAD),
qw(PRI_LOWEST EAT_NONE EAT_NeoStats NS_FAILURE),
qw(NS_SUCCESS KEEP REMOVE),
],
constants => [
- qw(PRI_HIGHEST PRI_HIGH PRI_NORM PRI_LOW),
+ qw(EVENT_MODULELOAD EVENT_MODULEUNLOAD PRI_NORM PRI_LOW),
qw(PRI_LOWEST EAT_NONE EAT_NeoStats),
qw(NS_FAILURE NS_SUCCESS FD_READ FD_WRITE),
qw(FD_EXCEPTION FD_NOTSOCKET KEEP REMOVE),
@@ -44,7 +44,6 @@
sub register {
my ($package) = caller;
- ($package) = caller(1) if $package eq 'IRC';
my $pkg_info = NeoStats::Embed::pkg_info( $package );
my $filename = $pkg_info->{filename};
@@ -52,13 +51,49 @@
$description = "" unless defined $description;
$pkg_info->{shutdown} = $callback;
+ $pkg_info->{name} = $name;
+ $pkg_info->{version} = $version;
+ $pkg_info->{description} = $description;
$pkg_info->{gui_entry} =
- NeoStats::Internal::register( $name, $version, $description);
+ NeoStats::Internal::register( $pkg_info->{name}, $pkg_info->{version}, $pkg_info->{description});
# keep with old behavior
- return ();
+ return NeoStats::NS_SUCCESS;
+ }
+
+
+
+ sub hook_event {
+ return undef unless @_ >= 2;
+
+ my $event = shift;
+ my $callback = shift;
+ my $options = shift;
+ my ($package) = caller;
+ my $flags = 0;
+ my $data = "";
+ $callback = NeoStats::Embed::fix_callback( $package, $callback );
+
+ if ( ref( $options ) eq 'HASH' ) {
+ if ( exists( $options->{flags} ) && defined( $options->{flags} ) ) {
+ $flags = $options->{flags};
+ }
+ if ( exists( $options->{data} ) && defined( $options->{data} ) ) {
+ $data = $options->{data};
+ }
+ }
+
+ my $pkg_info = NeoStats::Embed::pkg_info( $package );
+ my $hook = NeoStats::Internal::hook_event( $event, $flags, $callback, $data);
+ if ( defined ( $hook )) {
+ push @{$pkg_info->{hooks}}, $event;
+ return NeoStats::NS_SUCCESS;
+ } else {
+ return NeoStats::NS_FAILURE;
+ }
}
+
sub hook_server {
return undef unless @_ >= 2;
@@ -415,7 +450,7 @@
$string =~ s/\.pl$//i;
$string =~ s|([^A-Za-z0-9/])|'_'.unpack("H*",$1)|eg;
- return "NeoStats::Script::" . $string;
+ return "NeoStats::Module::" . $string;
}
sub pkg_info {
@@ -438,14 +473,15 @@
my $file = expand_homedir( shift @_ );
my $package = file2pkg( $file );
-
- if ( exists $scripts{$package} ) {
- my $pkg_info = pkg_info( $package );
- my $filename = File::Basename::basename( $pkg_info->{filename} );
- NeoStats::print( qq{'$filename' already loaded from '$pkg_info->{filename}'.\n} );
- NeoStats::print( 'If this is a different script then it rename and try loading it again.' );
- return 2;
- }
+# no need for this, as we only load one file per interpreter
+# print $package;
+# if ( exists $scripts{$package} ) {
+# my $pkg_info = pkg_info( $package );
+# my $filename = File::Basename::basename( $pkg_info->{filename} );
+# NeoStats::print( qq{'$filename' already loaded from '$pkg_info->{filename}'.\n} );
+# NeoStats::print( 'If this is a different script then it rename and try loading it again.' );
+# return 2;
+# }
if ( open FH, $file ) {
my $source = do {local $/; <FH>};
Modified: trunk/src/modules.c
==============================================================================
--- trunk/src/modules.c (original)
+++ trunk/src/modules.c Fri Jul 8 20:56:49 2005
@@ -147,7 +147,11 @@
{
SET_SEGV_LOCATION();
if (module_ptr->event_list) {
- if (module_ptr->event_list[event] && module_ptr->event_list[event]->handler) {
+ if ((IS_STD_MOD(module_ptr) && module_ptr->event_list[event] && module_ptr->event_list[event]->handler)
+#ifdef USE_PERL
+ || (IS_PERL_MOD(module_ptr) && module_ptr->event_list[event])
+#endif
+ ){
/* If we are not yet synched, check that the module supports
* the event before we are synched. */
if (!module_ptr->synched && !(module_ptr->event_list[event]->flags & EVENT_FLAG_IGNORE_SYNCH)) {
@@ -174,13 +178,19 @@
}
dlog(DEBUG1, "Running module %s with event %d", module_ptr->info->name, event);
SET_SEGV_LOCATION();
- if (setjmp (sigvbuf) == 0) {
- SET_RUN_LEVEL(module_ptr);
- module_ptr->event_list[event]->handler (cmdparams);
- RESET_RUN_LEVEL();
- } else {
- nlog (LOG_CRITICAL, "setjmp() Failed, Can't call Module %s", module_ptr->info->name);
- }
+ if (IS_STD_MOD(module_ptr)) {
+ if (setjmp (sigvbuf) == 0) {
+ SET_RUN_LEVEL(module_ptr);
+ module_ptr->event_list[event]->handler (cmdparams);
+ RESET_RUN_LEVEL();
+ } else {
+ nlog (LOG_CRITICAL, "setjmp() Failed, Can't call Module %s", module_ptr->info->name);
+ }
+#if USE_PERL
+ } else if (IS_PERL_MOD(module_ptr)) {
+ perl_event_cb(event, cmdparams, module_ptr);
+#endif
+ }
SET_SEGV_LOCATION();
}
}
Modified: trunk/src/perl.c
==============================================================================
--- trunk/src/perl.c (original)
+++ trunk/src/perl.c Fri Jul 8 20:56:49 2005
@@ -67,13 +67,13 @@
this is used for autoload and shutdown callbacks
*/
static int
-execute_perl1 (Module *mod, SV * function, int numargs, ...)
+execute_perl (Module *mod, SV * function, int numargs, ...)
{
int count, ret_value = 1;
SV *sv;
va_list args;
- char *tmpstr;
+ char *tmpstr[10];
PERL_SET_CONTEXT((PMI *)mod->pm->my_perl);
SET_RUN_LEVEL(mod);
@@ -81,16 +81,15 @@
dSP;
ENTER;
SAVETMPS;
+ PUSHMARK (SP);
va_start(args, numargs);
for (count = 0; count < numargs; count++) {
- tmpstr = va_arg(args, char *);
- XPUSHs (sv_2mortal (newSVpv (tmpstr, 0)));
+ tmpstr[count] = va_arg(args, char *);
+ XPUSHs (sv_2mortal (newSVpv (tmpstr[count], 0)));
}
va_end(args);
-
- PUSHMARK (SP);
PUTBACK;
count = call_sv (function, G_EVAL | G_SCALAR);
@@ -114,6 +113,168 @@
return ret_value;
}
+int
+perl_event_cb(Event evt, CmdParams *cmdparams, Module *mod_ptr) {
+ int ret = NS_FAILURE;
+printf("Event %d Module %s\n", evt, mod_ptr->info->name);
+ switch (evt) {
+ case EVENT_NULL:
+ 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);
+ break;
+ case EVENT_MODULEUNLOAD:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_SQUIT:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_PONG:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_QUIT:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ 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);
+ 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);
+ 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);
+ 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);
+ break;
+ case EVENT_BOTKILL:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_AWAY:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_SMODE:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_DELCHAN:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_PART:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 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, 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, 4, cmdparams->channel->name, cmdparams->source->name, cmdparams->bot->name, cmdparams->param);
+ 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);
+ 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);
+ break;
+ case EVENT_TOPIC:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ 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);
+ 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);
+ 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);
+ break;
+ case EVENT_GLOBOPS:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_WALLOPS:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ break;
+ case EVENT_CTCPVERSIONRPL:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ break;
+ case EVENT_CTCPVERSIONREQ:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ break;
+ case EVENT_CTCPFINGERRPL:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ break;
+ case EVENT_CTCPFINGERREQ:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ break;
+ case EVENT_CTCPACTIONREQ:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ break;
+ case EVENT_CTCPTIMERPL:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ break;
+ case EVENT_CTCPTIMEREQ:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 1, cmdparams->source->name);
+ break;
+ case EVENT_CTCPPINGRPL:
+ ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->source->name, cmdparams->param);
+ break;
+ case EVENT_CTCPPINGREQ:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_DCCCHAT:
+ ret = execute_perl(mod_ptr, mod_ptr->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);
+ break;
+ case EVENT_ADDBAN:
+ case EVENT_DELBAN:
+ dlog(DEBUG1, "EVENT_*BAN Todo!");
+ break;
+ case EVENT_COUNT:
+ /* nothing */
+ break;
+
+ }
+ return ret;
+}
+
+
#if 0
static int
@@ -333,7 +494,6 @@
static
XS (XS_NeoStats_register)
{
- char *name, *version, *desc;
Module *mod;
dXSARGS;
@@ -384,6 +544,48 @@
}
XSRETURN_EMPTY;
}
+
+/* NeoStats::Internal::hook_event(event, flags, callback, userdata) */
+static
+XS (XS_NeoStats_hook_event)
+{
+
+ ModuleEvent *evt;
+
+ dXSARGS;
+ if (items != 4) {
+ nlog(LOG_WARNING, "Usage: NeoStats::Internal::hook_event(event, flags, callback, userdata)");
+ } else {
+ evt = ns_calloc(sizeof(ModuleEvent));
+ evt->pe = ns_calloc(sizeof(PerlEvent));
+ evt->event = (int) SvIV (ST (0));
+ evt->flags = (int) SvIV (ST (1));
+ /* null, because its a perl event, which will execute via dedicated perl event handler */
+ evt->handler = NULL;
+ evt->pe->callback = sv_mortalcopy(ST (2));
+ SvREFCNT_inc (evt->pe->callback);
+ evt->pe->userdata = sv_mortalcopy(ST (3));
+ SvREFCNT_inc (evt->pe->userdata);
+ /* add it as a event */
+ AddEvent(evt);
+
+ XSRETURN_UV (PTR2UV (evt));
+ }
+}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#if 0
static
XS (XS_Xchat_emit_print)
@@ -440,7 +642,7 @@
}
/* NeoStats::Internal::hook_event(name, callback, userdata) */
static
-XS (XS_Xchat_hook_event)
+XS (XS_NeoStats_hook_event)
{
char *name;
@@ -694,6 +896,7 @@
/* load up all the custom IRC perl functions */
newXS ("NeoStats::Internal::debug", XS_NeoStats_debug, __FILE__);
newXS ("NeoStats::Internal::register", XS_NeoStats_register, __FILE__);
+ newXS ("NeoStats::Internal::hook_event", XS_NeoStats_hook_event, __FILE__);
stash = get_hv ("NeoStats::", TRUE);
if (stash == NULL) {
exit (1);
@@ -715,7 +918,8 @@
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_UMODE", newSViv (EVENT_UMODE));
+ newCONSTSUB (stash, "EVENT_SMODE", newSViv (EVENT_SMODE));
newCONSTSUB (stash, "EVENT_NEWCHAN", newSViv (EVENT_NEWCHAN));
newCONSTSUB (stash, "EVENT_DELCHAN", newSViv (EVENT_DELCHAN));
newCONSTSUB (stash, "EVENT_JOIN", newSViv (EVENT_JOIN));
@@ -814,6 +1018,10 @@
mod->insynch = 1;
if (!execute_perl (mod, sv_2mortal (newSVpv ("NeoStats::Embed::load", 0)),
1, (char *)filename)) {
+#if 0
+ if (!execute_perl (mod, sv_2mortal (newSVpv ("pkg_load", 0)),
+ 3, (char *)filename, (char *)filename, (char *)filename)) {
+#endif
/* XXX if we are here, check that pm->mod->info has something, otherwise the script didnt register */
if (!mod->info->name[0]) {
load_module_error(u, __("Perl Module %s didn't register. Unloading", u), filename);
@@ -850,7 +1058,7 @@
SET_RUN_LEVEL(mod);
if (mod->synched == 1) {
/* only execute unload if synced */
- execute_perl (mod, sv_2mortal (newSVpv ("NeoStats::Embed::unload", 0)), mod->pm->filename);
+ execute_perl (mod, sv_2mortal (newSVpv ("NeoStats::Embed::unload", 0)), 1, mod->pm->filename);
}
RESET_RUN_LEVEL();
}
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.