/* X-Chat 2.0 PERL Plugin * Copyright (C) 1998-2002 Peter Zelezny. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA */ #include #include #include #include #include #include #ifdef ENABLE_NLS #include #endif #ifdef WIN32 #include #else #include #endif #undef PACKAGE #ifdef WIN32 #include "../../config-win32.h" /* for #define OLD_PERL */ #else #include "../../config.h" #endif #include "hexchat-plugin.h" static hexchat_plugin *ph; /* plugin handle */ static int perl_load_file (char *script_name); #ifdef WIN32 /* STRINGIFY is from perl's CORE/config.h */ #ifndef PERL_REQUIRED_VERSION #define PERL_REQUIRED_VERSION STRINGIFY(PERL_REVISION) "." STRINGIFY(PERL_VERSION) #endif #ifndef PERL_DLL #define PERL_DLL "perl" STRINGIFY(PERL_REVISION) STRINGIFY(PERL_VERSION) ".dll" #endif static DWORD child (char *str) { MessageBoxA (0, str, "Perl DLL Error", MB_OK | MB_ICONHAND | MB_SETFOREGROUND | MB_TASKMODAL); return 0; } static void thread_mbox (char *str) { DWORD tid; CloseHandle (CreateThread (NULL, 0, (LPTHREAD_START_ROUTINE) child, str, 0, &tid)); } #endif /* leave this before XSUB.h, to avoid readdir() being redefined */ #ifdef WIN32 static void perl_auto_load_from_path (const char *path) { WIN32_FIND_DATA find_data; HANDLE find_handle; char *search_path; int path_len = strlen (path); /* +6 for \*.pl and \0 */ search_path = malloc(path_len + 6); sprintf (search_path, "%s\\*.pl", path); find_handle = FindFirstFile (search_path, &find_data); if (find_handle != INVALID_HANDLE_VALUE) { do { if (!(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY ||find_data.dwFileAttributes & FILE_ATTRIBUTE_HIDDEN)) { char *full_path = malloc (path_len + strlen (find_data.cFileName) + 2); sprintf (full_path, "%s\\%s", path, find_data.cFileName); perl_load_file (full_path); free (full_path); } } while (FindNextFile (find_handle, &find_data) != 0); FindClose (find_handle); } free (search_path); } #else static void perl_auto_load_from_path (const char *path) { DIR *dir; struct dirent *ent; dir = opendir (path); if (dir) { while ((ent = readdir (dir))) { int len = strlen (ent->d_name); if (len > 3 && strcasecmp (".pl", ent->d_name + len - 3) == 0) { char *file = malloc (len + strlen (path) + 2); sprintf (file, "%s/%s", path, ent->d_name); perl_load_file (file); free (file); } } closedir (dir); } } #endif static int perl_auto_load (void *unused) { const char *xdir; char *sub_dir; #ifdef WIN32 int copied = 0; char *slash = NULL; #endif /* get the dir in local filesystem encoding (what opendir() expects!) */ xdir = hexchat_get_info (ph, "configdir"); /* don't pollute the filesystem with script files, this only causes misuse of the folders * only use ~/.config/hexchat/addons/ and %APPDATA%\HexChat\addons */ #if 0 /* autoload from ~/.config/hexchat/ or %APPDATA%\HexChat\ on win32 */ perl_auto_load_from_path (xdir); #endif sub_dir = malloc (strlen (xdir) + 8); strcpy (sub_dir, xdir); strcat (sub_dir, "/addons"); perl_auto_load_from_path (sub_dir); free (sub_dir); #if 0 #ifdef WIN32 /* autoload from C:\Program Files\HexChat\plugins\ */ sub_dir = malloc (1025 + 9); copied = GetModuleFileName( 0, sub_dir, 1024 ); sub_dir[copied] = '\0'; slash = strrchr( sub_dir, '\\' ); if( slash != NULL ) { *slash = '\0'; } perl_auto_load_from_path ( strncat (sub_dir, "\\plugins", 9)); free (sub_dir); #endif #endif return 0; } #include #define WIN32IOP_H #include #include typedef struct { SV *callback; SV *userdata; hexchat_hook *hook; /* required for timers */ hexchat_context *ctx; /* allow timers to remember their context */ SV *package; /* need to track the package name when removing hooks by returning REMOVE */ unsigned int depth; } HookData; static PerlInterpreter *my_perl = NULL; extern void boot_DynaLoader (pTHX_ CV * cv); /* this is used for autoload and shutdown callbacks */ static int execute_perl (SV * function, char *args) { int count, ret_value = 1; dSP; ENTER; SAVETMPS; PUSHMARK (SP); XPUSHs (sv_2mortal (newSVpv (args, 0))); PUTBACK; count = call_sv (function, G_EVAL | G_SCALAR); SPAGAIN; if (SvTRUE (ERRSV)) { hexchat_printf(ph, "Perl error: %s\n", SvPV_nolen (ERRSV)); if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ } else if (count != 1) { hexchat_printf (ph, "Perl error: expected 1 value from %s, " "got: %d\n", SvPV_nolen (function), count); } else { ret_value = POPi; } PUTBACK; FREETMPS; LEAVE; return ret_value; } static char * get_filename (char *word[], char *word_eol[]) { int len; char *file; len = strlen (word[2]); /* if called as /load "filename.pl" the only difference between word and * word_eol will be the two quotes */ if (strchr (word[2], ' ') != NULL || (strlen (word_eol[2]) - strlen(word[2])) == 2 ) { file = word[2]; } else { file = word_eol[2]; } len = strlen (file); if (len > 3 && strncasecmp (".pl", file + len - 3, 3) == 0) { return file; } return NULL; } static SV * list_item_to_sv ( hexchat_list *list, const char *const *fields ) { HV *hash = newHV(); SV *field_value; const char *field; int field_index = 0; const char *field_name; int name_len; while (fields[field_index] != NULL) { field_name = fields[field_index] + 1; name_len = strlen (field_name); switch (fields[field_index][0]) { case 's': field = hexchat_list_str (ph, list, field_name); if (field != NULL) { field_value = newSVpvn (field, strlen (field)); } else { field_value = &PL_sv_undef; } break; case 'p': field_value = newSViv (PTR2IV (hexchat_list_str (ph, list, field_name))); break; case 'i': field_value = newSVuv (hexchat_list_int (ph, list, field_name)); break; case 't': field_value = newSVnv (hexchat_list_time (ph, list, field_name)); break; default: field_value = &PL_sv_undef; } (void)hv_store (hash, field_name, name_len, field_value, 0); field_index++; } return sv_2mortal (newRV_noinc ((SV *) hash)); } static AV * array2av (char *array[]) { int count 
/* GTK+ Preference Tool
 * Copyright (C) 2003-2005 Alex Shaduri.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
 */

/***************************************************************************
                          win32util.cpp  -  description
                             -------------------
    begin                : Tue Jan 14 2003
    copyright            : (C) 2003 by Alex Shaduri
    email                : alex_sh@land.ru
 ***************************************************************************/

#ifdef _WIN32

#include <string>
#include "sys_win32.h"
#include "win32util.h"





std::string win32_get_registry_value_string(HKEY base, const std::string& keydir, const std::string& key)
{

	HKEY reg_key = NULL;
	DWORD type;
	DWORD nbytes;
	char* result = NULL;
//HKEY_CURRENT_USER
	nbytes = 0;
	if ( RegOpenKeyEx ( base, keydir.c_str(), 0, KEY_QUERY_VALUE, &reg_key) == ERROR_SUCCESS
			&& RegQueryValueEx (reg_key, key.c_str(), 0, &type, NULL, &nbytes) == ERROR_SUCCESS ) {
		result = (char*)malloc(nbytes + 1);
		RegQueryValueEx (reg_key,  key.c_str(), 0, &type, (BYTE*)result, &nbytes);
		result[nbytes] = '\0';
	}

	if (reg_key != NULL)
		RegCloseKey (reg_key);

	std::string ret = "";

	if (result) {
		ret = result;
	}

	return ret;

}




void win32_set_registry_value_string(HKEY base, const std::string& keydir, const std::string& key, const std::string& value)
{

	HKEY reg_key = NULL;
	DWORD nbytes;

	nbytes = value.length() + 1;

	if ( RegOpenKeyEx ( base, keydir.c_str(), 0, KEY_QUERY_VALUE, &reg_key) == ERROR_SUCCESS) {
		RegSetValueEx (reg_key,  key.c_str(), 0, REG_SZ, (const BYTE*)(value.c_str()), nbytes);
	}

	if (reg_key != NULL)
		RegCloseKey (reg_key);

}







#endif
generated by cgit-pink 1.4.1 (git 2.36.1) at 2025-01-23 18:45:09 +0000
e or 0 */ /* otherwise leave it as NULL */ if (SvTRUE (ST (1)) || SvNIOK (ST (1))) { server = SvPV_nolen (ST (1)); /* hexchat_printf( ph, "XSUB - find_context( NULL, %s )", SvPV_nolen(ST(1) )); */ } /* else { hexchat_print( ph, "XSUB - 2 arg NULL server" ); } */ break; } RETVAL = hexchat_find_context (ph, server, chan); if (RETVAL != NULL) { /* hexchat_print (ph, "XSUB - context found"); */ XSRETURN_IV (PTR2IV (RETVAL)); } else { /* hexchat_print (ph, "XSUB - context not found"); */ XSRETURN_UNDEF; } } } static XS (XS_Xchat_get_context) { dXSARGS; if (items != 0) { hexchat_print (ph, "Usage: Xchat::get_context()"); } else { XSRETURN_IV (PTR2IV (hexchat_get_context (ph))); } } static XS (XS_Xchat_set_context) { hexchat_context *ctx; dXSARGS; if (items != 1) { hexchat_print (ph, "Usage: Xchat::set_context(ctx)"); } else { ctx = INT2PTR (hexchat_context *, SvUV (ST (0))); XSRETURN_IV ((IV) hexchat_set_context (ph, ctx)); } } static XS (XS_Xchat_nickcmp) { dXSARGS; if (items != 2) { hexchat_print (ph, "Usage: Xchat::nickcmp(s1, s2)"); } else { XSRETURN_IV ((IV) hexchat_nickcmp (ph, SvPV_nolen (ST (0)), SvPV_nolen (ST (1)))); } } static XS (XS_Xchat_get_list) { SV *name; hexchat_list *list; const char *const *fields; int count = 0; /* return value for scalar context */ dXSARGS; if (items != 1) { hexchat_print (ph, "Usage: Xchat::get_list(name)"); } else { SP -= items; /*remove the argument list from the stack */ name = ST (0); list = hexchat_list_get (ph, SvPV_nolen (name)); if (list == NULL) { XSRETURN_EMPTY; } if (GIMME_V == G_SCALAR) { while (hexchat_list_next (ph, list)) { count++; } hexchat_list_free (ph, list); XSRETURN_IV ((IV) count); } fields = hexchat_list_fields (ph, SvPV_nolen (name)); while (hexchat_list_next (ph, list)) { XPUSHs (list_item_to_sv (list, fields)); } hexchat_list_free (ph, list); PUTBACK; return; } } static XS (XS_Xchat_Embed_plugingui_remove) { void *gui_entry; dXSARGS; if (items != 1) { hexchat_print (ph, "Usage: Xchat::Embed::plugingui_remove(handle)"); } else { gui_entry = INT2PTR (void *, SvUV (ST (0))); hexchat_plugingui_remove (ph, gui_entry); } XSRETURN_EMPTY; } /* xs_init is the second argument perl_parse. As the name hints, it initializes XS subroutines (see the perlembed manpage) */ static void xs_init (pTHX) { HV *stash; SV *version; /* This one allows dynamic loading of perl modules in perl scripts by the 'use perlmod;' construction */ newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); /* load up all the custom IRC perl functions */ newXS ("Xchat::Internal::register", XS_Xchat_register, __FILE__); newXS ("Xchat::Internal::hook_server", XS_Xchat_hook_server, __FILE__); newXS ("Xchat::Internal::hook_command", XS_Xchat_hook_command, __FILE__); newXS ("Xchat::Internal::hook_print", XS_Xchat_hook_print, __FILE__); newXS ("Xchat::Internal::hook_timer", XS_Xchat_hook_timer, __FILE__); newXS ("Xchat::Internal::hook_fd", XS_Xchat_hook_fd, __FILE__); newXS ("Xchat::Internal::unhook", XS_Xchat_unhook, __FILE__); newXS ("Xchat::Internal::print", XS_Xchat_print, __FILE__); newXS ("Xchat::Internal::command", XS_Xchat_command, __FILE__); newXS ("Xchat::Internal::set_context", XS_Xchat_set_context, __FILE__); newXS ("Xchat::Internal::get_info", XS_Xchat_get_info, __FILE__); newXS ("Xchat::Internal::context_info", XS_Xchat_context_info, __FILE__); newXS ("Xchat::Internal::get_list", XS_Xchat_get_list, __FILE__); newXS ("Xchat::find_context", XS_Xchat_find_context, __FILE__); newXS ("Xchat::get_context", XS_Xchat_get_context, __FILE__); newXS ("Xchat::get_prefs", XS_Xchat_get_prefs, __FILE__); newXS ("Xchat::emit_print", XS_Xchat_emit_print, __FILE__); newXS ("Xchat::send_modes", XS_Xchat_send_modes, __FILE__); newXS ("Xchat::nickcmp", XS_Xchat_nickcmp, __FILE__); newXS ("Xchat::Embed::plugingui_remove", XS_Xchat_Embed_plugingui_remove, __FILE__); stash = get_hv ("Xchat::", TRUE); if (stash == NULL) { exit (1); } newCONSTSUB (stash, "PRI_HIGHEST", newSViv (HEXCHAT_PRI_HIGHEST)); newCONSTSUB (stash, "PRI_HIGH", newSViv (HEXCHAT_PRI_HIGH)); newCONSTSUB (stash, "PRI_NORM", newSViv (HEXCHAT_PRI_NORM)); newCONSTSUB (stash, "PRI_LOW", newSViv (HEXCHAT_PRI_LOW)); newCONSTSUB (stash, "PRI_LOWEST", newSViv (HEXCHAT_PRI_LOWEST)); newCONSTSUB (stash, "EAT_NONE", newSViv (HEXCHAT_EAT_NONE)); newCONSTSUB (stash, "EAT_XCHAT", newSViv (HEXCHAT_EAT_HEXCHAT)); newCONSTSUB (stash, "EAT_PLUGIN", newSViv (HEXCHAT_EAT_PLUGIN)); newCONSTSUB (stash, "EAT_ALL", newSViv (HEXCHAT_EAT_ALL)); newCONSTSUB (stash, "FD_READ", newSViv (HEXCHAT_FD_READ)); newCONSTSUB (stash, "FD_WRITE", newSViv (HEXCHAT_FD_WRITE)); newCONSTSUB (stash, "FD_EXCEPTION", newSViv (HEXCHAT_FD_EXCEPTION)); newCONSTSUB (stash, "FD_NOTSOCKET", newSViv (HEXCHAT_FD_NOTSOCKET)); newCONSTSUB (stash, "KEEP", newSViv (1)); newCONSTSUB (stash, "REMOVE", newSViv (0)); version = get_sv( "Xchat::VERSION", 1 ); sv_setpv( version, PACKAGE_VERSION ); } static void perl_init (void) { int warn; int arg_count; char *perl_args[] = { "", "-e", "0", "-w" }; char *env[] = { "" }; static const char xchat_definitions[] = { /* Redefine the $SIG{__WARN__} handler to have HexChat printing warnings in the main window. (TheHobbit) */ #include "xchat.pm.h" }; #ifdef OLD_PERL static const char irc_definitions[] = { #include "irc.pm.h" }; #endif #ifdef ENABLE_NLS /* Problem is, dynamicaly loaded modules check out the $] var. It appears that in the embedded interpreter we get 5,00503 as soon as the LC_NUMERIC locale calls for a comma instead of a point in separating integer and decimal parts. I realy can't understant why... The following appears to be an awful workaround... But it'll do until I (or someone else :)) found the "right way" to solve this nasty problem. (TheHobbit ) */ setlocale (LC_NUMERIC, "C"); #endif warn = 0; hexchat_get_prefs (ph, "perl_warnings", NULL, &warn); arg_count = warn ? 4 : 3; PERL_SYS_INIT3 (&arg_count, (char ***)&perl_args, (char ***)&env); my_perl = perl_alloc (); perl_construct (my_perl); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; perl_parse (my_perl, xs_init, arg_count, perl_args, (char **)NULL); /* Now initialising the perl interpreter by loading the perl_definition array. */ eval_pv (xchat_definitions, TRUE); #ifdef OLD_PERL eval_pv (irc_definitions, TRUE); #endif } static int perl_load_file (char *filename) { #ifdef WIN32 static HMODULE lib = NULL; if (!lib) { lib = LoadLibraryA (PERL_DLL); if (!lib) { if (GetLastError () == ERROR_BAD_EXE_FORMAT) /* http://forum.xchat.org/viewtopic.php?t=3277 */ thread_mbox ("Cannot use this " PERL_DLL "\n\n" #ifdef _WIN64 "64-bit Strawberry Perl is required."); #else "32-bit Strawberry Perl is required."); #endif else { /* a lot of people install this old version */ lib = LoadLibraryA ("perl56.dll"); if (lib) { FreeLibrary (lib); lib = NULL; thread_mbox ("Cannot open " PERL_DLL "!\n\n" "You must have a Visual C++ build of Perl " PERL_REQUIRED_VERSION " installed in order to\n" "run Perl scripts. A reboot may be required.\n\n" "http://hexchat.org/downloads.html\n\n" "I have found Perl 5.6, but that is too old."); } else { thread_mbox ("Cannot open " PERL_DLL "!\n\n" "You must have a Visual C++ build of Perl " PERL_REQUIRED_VERSION " installed in order to\n" "run Perl scripts. A reboot may be required.\n\n" "http://hexchat.org/downloads.html\n\n" "Make sure Perl's bin directory is in your PATH."); } } /* failure */ return FALSE; } /* success */ FreeLibrary (lib); } #endif if (my_perl == NULL) { perl_init (); } return execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::load", 0)), filename); } static void perl_end (void) { if (my_perl != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); PL_perl_destruct_level = 1; perl_destruct (my_perl); perl_free (my_perl); PERL_SYS_TERM(); my_perl = NULL; } } static int perl_command_unloadall (char *word[], char *word_eol[], void *userdata) { if (my_perl != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_HEXCHAT; } static int perl_command_reloadall (char *word[], char *word_eol[], void *userdata) { if (my_perl != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload_all", 0)), ""); return HEXCHAT_EAT_HEXCHAT; } else { perl_auto_load( NULL ); } return HEXCHAT_EAT_HEXCHAT; } static int perl_command_load (char *word[], char *word_eol[], void *userdata) { char *file = get_filename (word, word_eol); if (file != NULL ) { perl_load_file (file); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_NONE; } static int perl_command_unload (char *word[], char *word_eol[], void *userdata) { char *file = get_filename (word, word_eol); if (my_perl != NULL && file != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload", 0)), file); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_NONE; } static int perl_command_reload (char *word[], char *word_eol[], void *userdata) { char *file = get_filename (word, word_eol); if (my_perl != NULL && file != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload", 0)), file); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_HEXCHAT; } void hexchat_plugin_get_info (char **name, char **desc, char **version, void **reserved) { *name = "Perl"; *desc = "Perl scripting interface"; *version = PACKAGE_VERSION; if (reserved) *reserved = NULL; } /* Reinit safeguard */ static int initialized = 0; int hexchat_plugin_init (hexchat_plugin * plugin_handle, char **plugin_name, char **plugin_desc, char **plugin_version, char *arg) { if (initialized != 0) { hexchat_print (plugin_handle, "Perl interface already loaded\n"); return 0; } ph = plugin_handle; initialized = 1; *plugin_name = "Perl"; *plugin_desc = "Perl scripting interface"; *plugin_version = PACKAGE_VERSION; hexchat_hook_command (ph, "load", HEXCHAT_PRI_NORM, perl_command_load, 0, 0); hexchat_hook_command (ph, "unload", HEXCHAT_PRI_NORM, perl_command_unload, 0, 0); hexchat_hook_command (ph, "reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, 0); hexchat_hook_command (ph, "pl_reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, 0); hexchat_hook_command (ph, "unloadall", HEXCHAT_PRI_NORM, perl_command_unloadall, 0, 0); hexchat_hook_command (ph, "reloadall", HEXCHAT_PRI_NORM, perl_command_reloadall, 0, 0); /*perl_init (); */ hexchat_hook_timer (ph, 0, perl_auto_load, NULL ); hexchat_print (ph, "Perl interface loaded\n"); return 1; } int hexchat_plugin_deinit (hexchat_plugin * plugin_handle) { perl_end (); initialized = 0; hexchat_print (plugin_handle, "Perl interface unloaded\n"); return 1; }