perl.c

The major functionality added in this release includes: - Rootless mode in X11 - Widget Templt

/*
 * IRC::print_with_channel( text, channelname, servername )
 *    
 *   The servername is optional, channelname is required.
 *   Returns 1 on success, 0 on fail.
 */

static XS (XS_IRC_print_with_channel)
{
	int junk;
	char *output;
	struct session *sess;
	GSList *list = sess_list;
	char *channel, *server;
	dXSARGS;

	output = SvPV (ST (0), junk);
	channel = SvPV (ST (1), junk);
	server = SvPV (ST (2), junk);

	while (list)
	{
		sess = (struct session *) list->data;
		if (!server || !server[0]
			 || !strcasecmp (server, sess->server->servername))
		{
			if (sess->channel[0])
			{
				if (!strcasecmp (sess->channel, channel))
				{
					PrintText (sess, output);
					XSRETURN_YES;
				}
			}
		}
		list = list->next;
	}

	XSRETURN_NO;
}

static XS (XS_IRC_get_info)
{
	dXSARGS;

	if (!perl_sess)
	{
		XST_mPV (0, "Error1");
		XSRETURN (1);
	}
	switch (SvIV (ST (0)))
	{
	case 0:
		XST_mPV (0, VERSION);
		break;

	case 1:
		XST_mPV (0, perl_sess->server->nick);
		break;

	case 2:
		XST_mPV (0, perl_sess->channel);
		break;

	case 3:
		XST_mPV (0, perl_sess->server->servername);
		break;

	case 4:
		XST_mPV (0, get_xdir ());
		break;

	case 5:
		XST_mIV (0, perl_sess->server->is_away);
		break;

	default:
		XST_mPV (0, "Error2");
	}

	XSRETURN (1);
}

/* Added by TheHobbit <[e-mail]>*/
/* IRC::get_prefs(var) */
static XS (XS_IRC_get_prefs)
{
	int junk;
	char *var;
	int i = 0;
	dXSARGS;

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

	do
	{
		if (!strcasecmp (var, vars[i].name))
		{
			switch (vars[i].type)
			{
			case TYPE_STR:
				XST_mPV (0, (char *) &prefs + vars[i].offset);
				break;
			case TYPE_INT:
				XST_mIV (0, *((int *) &prefs + vars[i].offset));
				break;
			default:
			/*case TYPE_BOOL:*/
				if (*((int *) &prefs + vars[i].offset))
				{
					XST_mYES (0);
				} else
				{
					XST_mNO (0);
				}
				break;
			}
			XSRETURN (1);
		}
		i++;
	}
	while (vars[i].type != 0);
	XST_mPV (0, "Unknown variable");
	XSRETURN (1);
}

/* add handler for messages with message_type(ie PRIVMSG, 400, etc) */
/* IRC::add_message_handler(message_type, handler_name) */
static XS (XS_IRC_add_message_handler)
{
	int junk;
	struct _perl_inbound_handlers *handler;
	dXSARGS;

	handler = malloc (sizeof (struct _perl_inbound_handlers));
	handler->message_type = strdup (SvPV (ST (0), junk));
	handler->handler_name = strdup (SvPV (ST (1), junk));
	perl_inbound_handlers = g_slist_prepend (perl_inbound_handlers, handler);
	XSRETURN_EMPTY;
}

/* add handler for commands with command_name */
/* IRC::add_command_handler(command_name, handler_name) */
static XS (XS_IRC_add_command_handler)
{
	int junk;
	struct _perl_command_handlers *handler;
	dXSARGS;

	handler = malloc (sizeof (struct _perl_command_handlers));
	handler->command_name = strdup (SvPV (ST (0), junk));
	handler->handler_name = strdup (SvPV (ST (1), junk));
	perl_command_handlers = g_slist_prepend (perl_command_handlers, handler);
	XSRETURN_EMPTY;
}

/* add handler for commands with print_name */
/* IRC::add_print_handler(print_name, handler_name) */
static XS (XS_IRC_add_print_handler)
{
	int junk;
	struct _perl_print_handlers *handler;
	dXSARGS;

	handler = malloc (sizeof (struct _perl_print_handlers));
	handler->print_name = strdup (SvPV (ST (0), junk));
	handler->handler_name = strdup (SvPV (ST (1), junk));
	perl_print_handlers = g_slist_prepend (perl_print_handlers, handler);
	XSRETURN_EMPTY;
}

static XS (XS_IRC_add_timeout_handler)
{
	int junk;
	struct _perl_timeout_handlers *handler;
	dXSARGS;

	handler = malloc (sizeof (struct _perl_timeout_handlers));
	handler->handler_name = strdup (SvPV (ST (1), junk));
	perl_timeout_handlers = g_slist_prepend (perl_timeout_handlers, handler);
	handler->iotag = fe_timeout_add (SvIV (ST (0)), perl_timeout, handler);
	XSRETURN_EMPTY;
}

/* send raw data to server */
/* IRC::send_raw(data) */
static XS (XS_IRC_send_raw)
{
	char *data;
	int junk;
	dXSARGS;

	if (perl_sess)
	{
		data = strdup (SvPV (ST (0), junk));
		tcp_send (perl_sess->server, data);
		free (data);
	}
	XSRETURN_EMPTY;
}

static XS (XS_IRC_channel_list)
{
	struct session *sess;
	GSList *list = sess_list;
	int i = 0;
	dXSARGS;

	while (list)
	{
		sess = (struct session *) list->data;
		if (sess->channel[0])
		{
			XST_mPV (i, sess->channel);
			i++;
			XST_mPV (i, sess->server->servername);
			i++;
			XST_mPV (i, sess->server->nick);
			i++;
		}
		list = list->next;
	}

	XSRETURN (i);
}

static XS (XS_IRC_server_list)
{
	server *serv;
	GSList *list = serv_list;
	int i = 0;
	dXSARGS;

	while (list)
	{
		serv = list->data;
		if (serv->connected && serv->end_of_motd)
		{
			XST_mPV (i, serv->servername);
			i++;
		}
		list = list->next;
	}

	XSRETURN (i);
}

static XS (XS_IRC_ignore_list)
{
	struct ignore *ig;
	GSList *list = ignore_list;
	int i = 0;
	dXSARGS;

	while (list)
	{
		ig = (struct ignore *) list->data;

		XST_mPV (i, ig->mask);
		i++;
		XST_mIV (i, ig->priv);
		i++;
		XST_mIV (i, ig->chan);
		i++;
		XST_mIV (i, ig->ctcp);
		i++;
		XST_mIV (i, ig->noti);
		i++;
		XST_mIV (i, ig->invi);
		i++;
		XST_mIV (i, ig->unignore);
		i++;
		XST_mPV (i, ":");
		i++;

		list = list->next;
	}
	XSRETURN (i);
}

static XS (XS_IRC_notify_list)
{
	struct notify *not;
	struct notify_per_server *notserv;
	GSList *list = notify_list;
	GSList *notslist;
	int i = 0;
	dXSARGS;

	while (list)
	{
		not = (struct notify *) list->data;
		notslist = not->server_list;

		XST_mPV (i, not->name);
		i++;
		while (notslist)
		{
			notserv = (struct notify_per_server *)notslist->data;

			XST_mPV (i, notserv->server->servername);
			i++;
			XST_mIV (i, notserv->laston);
			i++;
			XST_mIV (i, notserv->lastseen);
			i++;
			XST_mIV (i, notserv->lastoff);
			i++;
			if (notserv->ison)
				XST_mYES (i);
			else
				XST_mNO (i);
			i++;
			XST_mPV (i, "::");
			i++;
			
			notslist = notslist->next;
		}
		XST_mPV (i, ":");
		i++;

		list = list->next;
	}
	
	XSRETURN (i);
}


/*

   IRC::user_info( nickname )

 */

static XS (XS_IRC_user_info)
{
	int junk;
	struct User *user;
	char *nick;
	dXSARGS;

	if (perl_sess)
	{
		nick = SvPV (ST (0), junk);
		if (nick[0] == 0)
			nick = perl_sess->server->nick;
		user = find_name (perl_sess, nick);
		if (user)
		{
			XST_mPV (0, user->nick);
			if (user->hostname)
				XST_mPV (1, user->hostname);
			else
				XST_mPV (1, "FETCHING");
			XST_mIV (2, user->op);
			XST_mIV (3, user->voice);
			XSRETURN (4);
		}
	}
	XSRETURN (0);
}

/*
 * IRC::add_user_list(ul_channel, ul_server, nick, user_host,
 * 		      realname, server)
 */
static XS (XS_IRC_add_user_list)
{
	int junk;
	char *ul_channel;
	char *ul_server;
	char *nick;
	char *user_host;	/* add_name() wants user and host merged */
	char *realname;
	char *server;
	struct session *sess;
	GSList *list = sess_list;
	dXSARGS;

	ul_channel = SvPV(ST(0), junk);
	ul_server  = SvPV(ST(1), junk);
	nick       = SvPV(ST(2), junk);
	user_host  = SvPV(ST(3), junk);
	realname   = SvPV(ST(4), junk);
	server     = SvPV(ST(5), junk);

	while (list) {
		sess = (struct session *) list->data;
		if (!server[0] || !strcasecmp(sess->server->servername, ul_server)) {
			if (!strcasecmp(sess->channel, ul_channel)) {
				add_name(sess, nick, NULL);
				userlist_add_hostname(sess, nick, user_host,
						      realname, server);
				XSRETURN_YES;
			}
		}
		list = list->next;
	}

	XSRETURN_NO;
}

/*
 * IRC::sub_user_list(ul_channel, ul_server, nick)
 */
static XS (XS_IRC_sub_user_list)
{
	int junk;
	char *channel;
	char *server;
	char *nick;
	struct session *sess;
	GSList *list = sess_list;
	dXSARGS;

	channel = SvPV(ST(0), junk);
	server  = SvPV(ST(1), junk);
	nick    = SvPV(ST(2), junk);

	while (list) {
		sess = (struct session *) list->data;
		if (!server[0] || !strcasecmp(sess->server->servername, server)) {
			if (!strcasecmp(sess->channel, channel)) {
				sub_name(sess, nick);
				XSRETURN_YES;
			}
		}
		list = list->next;
	}

	XSRETURN_NO;
}

/*
 * IRC::clear_user_list(channel, server)
 */
static XS (XS_IRC_clear_user_list)
{
	int junk;
	char *channel, *server;
	struct session *sess;
	GSList *list = sess_list;
	dXSARGS;

	channel = SvPV(ST(0), junk);
	server  = SvPV(ST(1), junk);

	while (list) {
		sess = (struct session *) list->data;
		if (!server[0] || !strcasecmp(sess->server->servername, server)) {
			if (!strcasecmp(sess->channel, channel)) {
				clear_user_list(sess);
				XSRETURN_YES;
			}
		}
		list = list->next;
	}

	XSRETURN_NO;
};

/*

   IRC::user_list( channel, server )

 */

static XS (XS_IRC_user_list)
{
	struct User *user;
	struct session *sess;
	char *channel, *server;
	GSList *list = sess_list;
	int i = 0, junk;
	int MinStk = 10;
	dXSARGS;

	EXTEND (SP, MinStk);

	channel = SvPV (ST (0), junk);
	server = SvPV (ST (1), junk);

	while (list)
	{
		sess = (struct session *) list->data;
		if (!server[0] || !strcasecmp (sess->server->servername, server))
		{
			if (!strcasecmp (sess->channel, channel) && sess->type == SESS_CHANNEL)
			{
				list = sess->userlist;
				while (list)
				{
					user = (struct User *) list->data;
					XST_mPV (i, user->nick);
					i++;
					if (user->hostname)
						XST_mPV (i, user->hostname);
					else
						XST_mPV (i, "FETCHING");
					i++;
					XST_mIV (i, user->op);
					i++;
					XST_mIV (i, user->voice);
					i++;
					XST_mPV (i, ":");
					i++;
					list = list->next;
					/* Make sure there is room on the stack */
					MinStk = i + 10;
					EXTEND(SP, MinStk);
				}
				XSRETURN (i);
			}
		}
		list = list->next;
	}
	XSRETURN (i);
}

static XS (XS_IRC_dcc_list)
{
	struct DCC *dcc;
	GSList *list = dcc_list;
	int i = 0;
	dXSARGS;

	while (list)
	{
		dcc = (struct DCC *) list->data;
		XST_mPV (i, dcc->nick);
		i++;
		if (dcc->file)
			XST_mPV (i, dcc->file);
		else
			XST_mPV (i, "");
		i++;
		XST_mIV (i, dcc->type);
		i++;
		XST_mIV (i, dcc->dccstat);
		i++;
		XST_mIV (i, dcc->cps);
		i++;
		XST_mIV (i, dcc->size);
		i++;
		XST_mIV (i, dcc->resumable);
		i++;
		XST_mIV (i, dcc->addr);
		i++;
		if (dcc->destfile)
			XST_mPV (i, dcc->destfile);
		else
			XST_mPV (i, "");
		i++;
		list = list->next;
	}

	XSRETURN (i);
}

/* run internal xchat command */
/* IRC::command(command) */
static XS (XS_IRC_command)
{
	char *command;
	int junk;
	dXSARGS;

	if (perl_sess)
	{
		command = strdup (SvPV (ST (0), junk));
		handle_command (command, perl_sess, FALSE, FALSE);
		free (command);
	}
	XSRETURN_EMPTY;
}

static XS (XS_IRC_command_with_server)
{
	GSList *list = serv_list;
	struct server *serv;
	char *server, *command;
	int junk;
	dXSARGS;

	server = strdup (SvPV (ST (1), junk));

	while (list)
	{
		serv = (struct server *) list->data;
		if (!strcmp (serv->servername, server))
		{
			command = strdup (SvPV (ST (0), junk));
			if (!serv->front_session)
			{
				struct session *sess;
				GSList *list = sess_list;
				/*fprintf(stderr, "*** Perl Error: no front_session\n"); */
				while (list)
				{
					sess = (struct session *) list->data;
					if (sess->server == serv)
					{
						/*fprintf(stderr, "*** Using %lx instead\n", (unsigned long)sess); */
						handle_command (command, sess, FALSE, FALSE);
						break;
					}
					list = list->next;
				}
			} else
				handle_command (command, serv->front_session, FALSE, FALSE);
			free (command);
			free (server);
			XSRETURN_EMPTY;
		}
		list = list->next;
	}

	free (server);
	XSRETURN_EMPTY;
}

/* MAG030600: BEGIN IRC::user_list_short */
/*

   IRC::user_list_short( channel, server )
   returns a shorter user list consisting of pairs of nick & user@host
   suitable for assigning to a hash.  modified IRC::user_list()
   
 */
static XS (XS_IRC_user_list_short)
{
	struct User *user;
	struct session *sess;
	char *channel, *server;
	GSList *list = sess_list;
	int i = 0, junk;
	int MinStk = 10;
	dXSARGS;

	EXTEND (SP, MinStk);

	channel = SvPV (ST (0), junk);
	server = SvPV (ST (1), junk);

	while (list)
	{
		sess = (struct session *) list->data;
		if (!server[0] || !strcasecmp (sess->server->servername, server))
		{
			if (!strcasecmp (sess->channel, channel) && sess->type == SESS_CHANNEL)
			{
				list = sess->userlist;
				while (list)
				{
					user = (struct User *) list->data;
					XST_mPV (i, user->nick);
					i++;
					if (user->hostname)
						XST_mPV (i, user->hostname);
					else
						XST_mPV (i, "FETCHING");
					i++;
					list = list->next;
					/* Make sure there is room on the stack */
					MinStk = i + 10;
					EXTEND(SP, MinStk);
				}
				XSRETURN (i);
			}
		}
		list = list->next;
	}
	XSRETURN (i);
}
/* MAG030600: END */


/* MAG030600 BEGIN IRC::perl_script_list() */
/* return a list of currently loaded perl script names and versions */
static XS (XS_IRC_perl_script_list)
{
	int i = 0;
	GSList *handler;
	dXSARGS;

	handler = perl_list;
	while (handler)
	{
		struct perlscript *scp = handler->data;
		XST_mPV (i, scp->name);
		i++;
		XST_mPV (i, scp->version);
		i++;
		handler = handler->next;
	}
	XSRETURN(i);
}
/* MAG030600 END */