comparison plugins/perl/perl.c @ 6485:70d5122bc3ff

[gaim-migrate @ 6999] Removed the old event system and replaced it with a much better signal system. There will most likely be some bugs in this, but it seems to be working for now. Plugins can now generate their own signals, and other plugins can find those plugins and connect to them. This could give plugins a form of IPC. It's also useful for other things. It's rather flexible, except for the damn marshalling, but there's no way around that that I or the glib people can see. committer: Tailor Script <[e-mail]>

6484:5ced8e111473

	newXS ("GAIM::add_timeout_handler", XS_GAIM_add_timeout_handler, "GAIM");

	newXS ("GAIM::play_sound", XS_GAIM_play_sound, "GAIM");
}

static char *
escape_quotes(const char *buf)
{
	static char *tmp_buf = NULL;
	const char *i;

	return tmp_buf;
}

/*
  2003/02/06: execute_perl modified by Mark Doliner <[e-mail]>
		Pass parameters by pushing them onto the stack rather than 
		passing an array of strings.  This way, perl scripts can 
		modify the parameters and we can get the changed values 
		and then shoot ourselves.  I mean, uh, use them.

  2001/06/14: execute_perl replaced by Martin Persson <[e-mail]>
		previous use of perl_eval leaked memory, replaced with
		a version that uses perl_call instead

  30/11/2002: execute_perl modified by Eric Timme <[e-mail]>
		args changed to char** so that we can have preparsed
  		arguments again, and many headaches ensued! This essentially 
		means we replaced one hacked method with a messier hacked 
		method out of perceived necessity. Formerly execute_perl 
		required a single char_ptr, and it would insert it into an 
		array of character pointers and NULL terminate the new array.
		Now we have to pass in pre-terminated character pointer arrays
		to accomodate functions that want to pass in multiple arguments.

		Previously arguments were preparsed because an argument list
		was constructed in the form 'arg one','arg two' and was
		executed via a call like &funcname(arglist) (see .59.x), so
		the arglist was magically pre-parsed because of the method. 
		With Martin Persson's change to perl_call we now need to
		use a null terminated list of character pointers for arguments
		if we wish them to be parsed. Lacking a better way to allow
		for both single arguments and many I created a NULL terminated
		array in every function that called execute_perl and passed

		the array sizes?  I am not comfortable enough with this
		subject to attempt it myself and hope it to stand the test
		of time.
*/

static int 
execute_perl(const char *function, int argc, char **args)
{
	int count = 0, i, ret_value = 1;
	SV *sv_args[argc];
	STRLEN na;

	/*
	 * Set up the perl environment, push arguments onto the 
	 * perl stack, then call the given function
	 */
	dSP;
	ENTER;
	SAVETMPS;

				execute_perl(scp->shutdowncallback, 1, atmp);

			g_free(scp->name);
			g_free(scp->version);
			g_free(scp->shutdowncallback);
			g_free(scp);	

			break;
		}
	}

		plugin->error = g_strdup(_("GAIM::register not called with "
								   "proper arguments.  Consult PERL-HOWTO."));

		return 0;
	}
	
	return ret;
}

static void
perl_init(void)

	{
		/* We use to function one to load a file the other to
		   execute the string obtained from the first and holding
		   the file conents. This allows to have a realy local $/
		   without introducing temp variables to hold the old
		   value. Just a question of style:) */ 
		"sub load_file{"
		  "my $f_name=shift;"
		  "local $/=undef;"
		  "open FH,$f_name or return \"__FAILED__\";"
		  "$_=<FH>;"

	if (plug) {
		scp = g_new0(struct perlscript, 1);
		scp->name = g_strdup(name);
		scp->version = g_strdup(ver);
		scp->shutdowncallback = g_strdup(callback);
		scp->plug = plug; 
		perl_list = g_list_append(perl_list, scp);
		XST_mPV(0, plug->path);
	}
	else
		XST_mPV(0, NULL);

	nick = SvPV(ST(0), junk);
	send = SvIV(ST(1));
	what = SvPV(ST(2), junk);
	who = SvPV(ST(3), junk);
	
	if (!*who) who=NULL;
	
	switch (send) {
		case 0: wflags=WFLAG_SEND; break;
		case 1: wflags=WFLAG_RECV; break;
		case 2: wflags=WFLAG_SYSTEM; break;
		default: wflags=WFLAG_RECV;
	}	

	c = gaim_find_conversation(nick);

	if (!c)
		c = gaim_conversation_new(GAIM_CONV_IM, NULL, nick);

	if (!c)
		c = gaim_conversation_new(GAIM_CONV_IM, gc->account, nick);
	else
		gaim_conversation_set_account(c, gc->account);

	gaim_conversation_write(c, NULL, what, -1, 
				(WFLAG_SEND | (isauto ? WFLAG_AUTO : 0)), time(NULL));
	serv_send_im(gc, nick, what, -1, isauto ? IM_FLAG_AWAY : 0);
	XSRETURN(0);
}


	
XS (XS_GAIM_print_to_chat)
{
	GaimConnection *gc;
	int id;
	char *what;

	if (b)
		serv_chat_send(gc, id, what);
	XSRETURN(0);
}

static int
perl_event(GaimEvent event, void *unused, va_list args)
{
	char *buf[5] = { NULL, NULL, NULL, NULL, NULL }; /* Maximum of 5 args */
	void *arg1 = NULL, *arg2 = NULL, *arg3 = NULL, *arg4 = NULL, *arg5 = NULL;

		break;
	}

	return 0;
}

XS (XS_GAIM_add_event_handler)
{
	unsigned int junk;
	struct _perl_event_handlers *handler;
	char *handle;
	GaimPlugin *plug;
	GList *p;
	dXSARGS;
	items = 0;
	
	handle = SvPV(ST(0), junk);

	for (p = gaim_plugins_get_all(); p != NULL; p = p->next) {
		plug = p->data;

		if (!strcmp(handle, plug->path))

	} else {
		gaim_debug(GAIM_DEBUG_ERROR, "perl",
				   "Invalid handle (%s) registering perl event handler\n",
				   handle);
	}
	
	XSRETURN_EMPTY;
}

XS (XS_GAIM_remove_event_handler)
{

	long timeout;
	struct _perl_timeout_handlers *handler;
	char *handle;
	GaimPlugin *plug;
	GList *p;
	
	dXSARGS;
	items = 0;
	
	handle = SvPV(ST(0), junk);

	for (p = gaim_plugins_get_all(); p != NULL; p = p->next) {
		plug = p->data;

	int count;
	gboolean status = TRUE;

	perl_construct(prober);
	perl_parse(prober, xs_init, 2, argv, NULL);
	
	{
		dSP;
		ENTER;
		SAVETMPS;
		PUSHMARK(SP);

	NULL,                                             /**< exts           */

	probe_perl_plugin,                                /**< probe          */
	load_perl_plugin,                                 /**< load           */
	unload_perl_plugin,                               /**< unload         */
	destroy_perl_plugin,                              /**< destroy        */
	perl_event                                        /**< broadcast      */
};

static GaimPluginInfo info =
{
	2,                                                /**< api_version    */

6485:70d5122bc3ff

	newXS ("GAIM::add_timeout_handler", XS_GAIM_add_timeout_handler, "GAIM");

	newXS ("GAIM::play_sound", XS_GAIM_play_sound, "GAIM");
}

#if 0
#define COMPARE_EVENT(evt, sig, h) \
	if (!strcmp(event_name, (evt))) \
	{ \
		*signal_name = (sig); \
		*handle = (h); \
		return TRUE; \
	}

static gboolean
convert_event_to_signal(const char *event_name, const char **signal_name,
						void **handle)
{
	void *conn_handle    = gaim_connections_get_handle();
	void *account_handle = gaim_accounts_get_handle();
	void *conv_handle    = gaim_conversations_get_handle();
	void *blist_handle   = gaim_get_blist();

	COMPARE_EVENT("event_signon",  "signed-on",   conn_handle);
	COMPARE_EVENT("event_signoff", "signed-off",  conn_handle);

	COMPARE_EVENT("event_away",       "account-away",       account_handle);
	COMPARE_EVENT("event_back",       "account-back",       account_handle);
	COMPARE_EVENT("event_warned",     "account-warned",     account_handle);
	COMPARE_EVENT("event_set_info",   "account-set-info",   account_handle);
	COMPARE_EVENT("event_connecting", "account-connecting", account_handle);

	COMPARE_EVENT("event_im_recv",          "received-im-msg",   conv_handle);
	COMPARE_EVENT("event_im_send",          "sent-im-msg",       conv_handle);
	COMPARE_EVENT("event_chat_invited",     "chat-invited",      conv_handle);
	COMPARE_EVENT("event_chat_join",        "chat-joined",       conv_handle);
	COMPARE_EVENT("event_chat_leave",       "chat-left",         conv_handle);
	COMPARE_EVENT("event_chat_buddy_join",  "chat-buddy-joined", conv_handle);
	COMPARE_EVENT("event_chat_buddy_leave", "chat-buddy-left",   conv_handle);
	COMPARE_EVENT("event_chat_recv",        "received-chat-msg", conv_handle);
	COMPARE_EVENT("event_chat_send",        "sent-chat-msg",     conv_handle);
	COMPARE_EVENT("event_new_conversation", "conversation-created",
				  conv_handle);
	COMPARE_EVENT("event_im_displayed_sent", "sending-im-msg", conv_handle);
	COMPARE_EVENT("event_im_displayed_rcvd", NULL, NULL);
	COMPARE_EVENT("event_chat_send_invite", "chat-inviting-user", conv_handle);
	COMPARE_EVENT("event_got_typing", "buddy-typing", conv_handle);
	COMPARE_EVENT("event_del_conversation", "deleting-conversation",
				  conv_handle);
	COMPARE_EVENT("event_conversation_switch", "conversation-switched",
				  conv_handle);

	COMPARE_EVENT("event_buddy_signon",  "buddy-signed-on",  blist_handle);
	COMPARE_EVENT("event_buddy_signoff", "buddy-signed-off", blist_handle);
	COMPARE_EVENT("event_buddy_away",    "buddy-away",       blist_handle);
	COMPARE_EVENT("event_buddy_back",    "buddy-back",       blist_handle);
	COMPARE_EVENT("event_buddy_idle",    "buddy-idle",       blist_handle);
	COMPARE_EVENT("event_buddy_unidle",  "buddy-unidle",     blist_handle);
	COMPARE_EVENT("event_blist_update",  "update-idle",      blist_handle);

	COMPARE_EVENT("event_quit", "quitting", gaim_get_core());

	*signal_name = NULL;
	*handle = NULL;

	return FALSE;
}
#endif

static char *
escape_quotes(const char *buf)
{
	static char *tmp_buf = NULL;
	const char *i;

	return tmp_buf;
}

/*
  2003/02/06: execute_perl modified by Mark Doliner <[e-mail]>
		Pass parameters by pushing them onto the stack rather than
		passing an array of strings.  This way, perl scripts can
		modify the parameters and we can get the changed values
		and then shoot ourselves.  I mean, uh, use them.

  2001/06/14: execute_perl replaced by Martin Persson <[e-mail]>
		previous use of perl_eval leaked memory, replaced with
		a version that uses perl_call instead

  30/11/2002: execute_perl modified by Eric Timme <[e-mail]>
		args changed to char** so that we can have preparsed
  		arguments again, and many headaches ensued! This essentially
		means we replaced one hacked method with a messier hacked
		method out of perceived necessity. Formerly execute_perl
		required a single char_ptr, and it would insert it into an
		array of character pointers and NULL terminate the new array.
		Now we have to pass in pre-terminated character pointer arrays
		to accomodate functions that want to pass in multiple arguments.

		Previously arguments were preparsed because an argument list
		was constructed in the form 'arg one','arg two' and was
		executed via a call like &funcname(arglist) (see .59.x), so
		the arglist was magically pre-parsed because of the method.
		With Martin Persson's change to perl_call we now need to
		use a null terminated list of character pointers for arguments
		if we wish them to be parsed. Lacking a better way to allow
		for both single arguments and many I created a NULL terminated
		array in every function that called execute_perl and passed

		the array sizes?  I am not comfortable enough with this
		subject to attempt it myself and hope it to stand the test
		of time.
*/

static int
execute_perl(const char *function, int argc, char **args)
{
	int count = 0, i, ret_value = 1;
	SV *sv_args[argc];
	STRLEN na;

	/*
	 * Set up the perl environment, push arguments onto the
	 * perl stack, then call the given function
	 */
	dSP;
	ENTER;
	SAVETMPS;

				execute_perl(scp->shutdowncallback, 1, atmp);

			g_free(scp->name);
			g_free(scp->version);
			g_free(scp->shutdowncallback);
			g_free(scp);

			break;
		}
	}

		plugin->error = g_strdup(_("GAIM::register not called with "
								   "proper arguments.  Consult PERL-HOWTO."));

		return 0;
	}

	return ret;
}

static void
perl_init(void)

	{
		/* We use to function one to load a file the other to
		   execute the string obtained from the first and holding
		   the file conents. This allows to have a realy local $/
		   without introducing temp variables to hold the old
		   value. Just a question of style:) */
		"sub load_file{"
		  "my $f_name=shift;"
		  "local $/=undef;"
		  "open FH,$f_name or return \"__FAILED__\";"
		  "$_=<FH>;"

	if (plug) {
		scp = g_new0(struct perlscript, 1);
		scp->name = g_strdup(name);
		scp->version = g_strdup(ver);
		scp->shutdowncallback = g_strdup(callback);
		scp->plug = plug;
		perl_list = g_list_append(perl_list, scp);
		XST_mPV(0, plug->path);
	}
	else
		XST_mPV(0, NULL);

	nick = SvPV(ST(0), junk);
	send = SvIV(ST(1));
	what = SvPV(ST(2), junk);
	who = SvPV(ST(3), junk);

	if (!*who) who=NULL;

	switch (send) {
		case 0: wflags=WFLAG_SEND; break;
		case 1: wflags=WFLAG_RECV; break;
		case 2: wflags=WFLAG_SYSTEM; break;
		default: wflags=WFLAG_RECV;
	}

	c = gaim_find_conversation(nick);

	if (!c)
		c = gaim_conversation_new(GAIM_CONV_IM, NULL, nick);

	if (!c)
		c = gaim_conversation_new(GAIM_CONV_IM, gc->account, nick);
	else
		gaim_conversation_set_account(c, gc->account);

	gaim_conversation_write(c, NULL, what, -1,
				(WFLAG_SEND | (isauto ? WFLAG_AUTO : 0)), time(NULL));
	serv_send_im(gc, nick, what, -1, isauto ? IM_FLAG_AWAY : 0);
	XSRETURN(0);
}



XS (XS_GAIM_print_to_chat)
{
	GaimConnection *gc;
	int id;
	char *what;

	if (b)
		serv_chat_send(gc, id, what);
	XSRETURN(0);
}

#if 0
static int
perl_event(GaimEvent event, void *unused, va_list args)
{
	char *buf[5] = { NULL, NULL, NULL, NULL, NULL }; /* Maximum of 5 args */
	void *arg1 = NULL, *arg2 = NULL, *arg3 = NULL, *arg4 = NULL, *arg5 = NULL;

		break;
	}

	return 0;
}
#endif

XS (XS_GAIM_add_event_handler)
{
	unsigned int junk;
	struct _perl_event_handlers *handler;
	char *handle;
	GaimPlugin *plug;
	GList *p;
	dXSARGS;
	items = 0;

	handle = SvPV(ST(0), junk);

	gaim_debug(GAIM_DEBUG_ERROR, "perl",
			   "Ay, sorry matey. Ye perl scripts are getting "
			   "events no more. Argh.\n");

	for (p = gaim_plugins_get_all(); p != NULL; p = p->next) {
		plug = p->data;

		if (!strcmp(handle, plug->path))

	} else {
		gaim_debug(GAIM_DEBUG_ERROR, "perl",
				   "Invalid handle (%s) registering perl event handler\n",
				   handle);
	}

	XSRETURN_EMPTY;
}

XS (XS_GAIM_remove_event_handler)
{

	long timeout;
	struct _perl_timeout_handlers *handler;
	char *handle;
	GaimPlugin *plug;
	GList *p;

	dXSARGS;
	items = 0;

	handle = SvPV(ST(0), junk);

	for (p = gaim_plugins_get_all(); p != NULL; p = p->next) {
		plug = p->data;

	int count;
	gboolean status = TRUE;

	perl_construct(prober);
	perl_parse(prober, xs_init, 2, argv, NULL);

	{
		dSP;
		ENTER;
		SAVETMPS;
		PUSHMARK(SP);

	NULL,                                             /**< exts           */

	probe_perl_plugin,                                /**< probe          */
	load_perl_plugin,                                 /**< load           */
	unload_perl_plugin,                               /**< unload         */
	destroy_perl_plugin                               /**< destroy        */
};

static GaimPluginInfo info =
{
	2,                                                /**< api_version    */