]>
Commit | Line | Data |
---|---|---|
6afa2506 | 1 | /* X-Chat 2.0 PERL Plugin |
2 | * Copyright (C) 1998-2002 Peter Zelezny. | |
3 | * | |
4 | * This program is free software; you can redistribute it and/or modify | |
5 | * it under the terms of the GNU General Public License as published by | |
6 | * the Free Software Foundation; either version 2 of the License, or | |
7 | * (at your option) any later version. | |
8 | * | |
9 | * This program is distributed in the hope that it will be useful, | |
10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
24cb6d4e | 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
6afa2506 | 12 | * GNU General Public License for more details. |
13 | * | |
14 | * You should have received a copy of the GNU General Public License | |
15 | * along with this program; if not, write to the Free Software | |
16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA | |
17 | */ | |
18 | ||
24cb6d4e | 19 | #include <stdlib.h> |
8ad38b0e | 20 | #include <stdio.h> |
6afa2506 | 21 | #include <string.h> |
24cb6d4e | 22 | #include <sys/types.h> |
23 | #include <sys/stat.h> | |
24 | #include <fcntl.h> | |
25 | #include <dirent.h> | |
6afa2506 | 26 | #ifdef ENABLE_NLS |
27 | #include <locale.h> | |
28 | #endif | |
7cdb6dbc | 29 | #ifdef WIN32 |
30 | #include <windows.h> | |
31 | #endif | |
6afa2506 | 32 | |
33 | #undef PACKAGE | |
24cb6d4e | 34 | #include "../../config.h" /* for #define OLD_PERL */ |
6afa2506 | 35 | #include "xchat-plugin.h" |
6afa2506 | 36 | |
23bce193 | 37 | static xchat_plugin *ph; /* plugin handle */ |
6afa2506 | 38 | |
39 | static int perl_load_file (char *script_name); | |
6afa2506 | 40 | |
7cdb6dbc | 41 | #ifdef WIN32 |
42 | ||
43 | static DWORD | |
44 | child (char *str) | |
45 | { | |
23bce193 | 46 | MessageBoxA (0, str, "Perl DLL Error", |
47 | MB_OK | MB_ICONHAND | MB_SETFOREGROUND | MB_TASKMODAL); | |
48 | return 0; | |
7cdb6dbc | 49 | } |
50 | ||
51 | static void | |
52 | thread_mbox (char *str) | |
53 | { | |
23bce193 | 54 | DWORD tid; |
7cdb6dbc | 55 | |
23bce193 | 56 | CloseHandle (CreateThread (NULL, 0, (LPTHREAD_START_ROUTINE) child, |
57 | str, 0, &tid)); | |
7cdb6dbc | 58 | } |
59 | ||
60 | #endif | |
6afa2506 | 61 | |
24cb6d4e | 62 | /* leave this before XSUB.h, to avoid readdir() being redefined */ |
7353973b | 63 | |
24cb6d4e | 64 | static void |
7353973b | 65 | perl_auto_load_from_path (const char *path) |
24cb6d4e | 66 | { |
67 | DIR *dir; | |
68 | struct dirent *ent; | |
24cb6d4e | 69 | |
7353973b | 70 | dir = opendir (path); |
23bce193 | 71 | if (dir) { |
72 | while ((ent = readdir (dir))) { | |
24cb6d4e | 73 | int len = strlen (ent->d_name); |
23bce193 | 74 | if (len > 3 && strcasecmp (".pl", ent->d_name + len - 3) == 0) { |
7353973b | 75 | char *file = malloc (len + strlen (path) + 2); |
76 | sprintf (file, "%s/%s", path, ent->d_name); | |
24cb6d4e | 77 | perl_load_file (file); |
78 | free (file); | |
79 | } | |
80 | } | |
81 | closedir (dir); | |
82 | } | |
83 | } | |
84 | ||
e247cb15 | 85 | static int |
86 | perl_auto_load (void *unused) | |
7353973b | 87 | { |
88 | const char *xdir; | |
5069db65 | 89 | char *sub_dir; |
81e29d6e | 90 | #ifdef WIN32 |
f735e75f | 91 | int copied = 0; |
81e29d6e | 92 | char *slash = NULL; |
93 | #endif | |
7353973b | 94 | |
95 | /* get the dir in local filesystem encoding (what opendir() expects!) */ | |
96 | xdir = xchat_get_info (ph, "xchatdirfs"); | |
5069db65 | 97 | if (!xdir) /* xchatdirfs is new for 2.0.9, will fail on older */ |
7353973b | 98 | xdir = xchat_get_info (ph, "xchatdir"); |
99 | ||
100 | /* autoload from ~/.xchat2/ or ${APPDATA}\X-Chat 2\ on win32 */ | |
101 | perl_auto_load_from_path (xdir); | |
102 | ||
5069db65 | 103 | sub_dir = malloc (strlen (xdir) + 9); |
104 | strcpy (sub_dir, xdir); | |
105 | strcat (sub_dir, "/plugins"); | |
106 | perl_auto_load_from_path (sub_dir); | |
107 | free (sub_dir); | |
108 | ||
7353973b | 109 | #ifdef WIN32 |
110 | /* autoload from C:\program files\xchat\plugins\ */ | |
f735e75f | 111 | sub_dir = malloc (1025 + 9); |
112 | copied = GetModuleFileName( 0, sub_dir, 1024 ); | |
113 | sub_dir[copied] = '\0'; | |
114 | slash = strrchr( sub_dir, '\\' ); | |
115 | if( slash != NULL ) { | |
116 | *slash = '\0'; | |
117 | } | |
118 | perl_auto_load_from_path ( strncat (sub_dir, "\\plugins", 9)); | |
119 | free (sub_dir); | |
7353973b | 120 | #endif |
e247cb15 | 121 | return 0; |
7353973b | 122 | } |
123 | ||
8ad38b0e | 124 | #include <EXTERN.h> |
125 | #define WIN32IOP_H | |
126 | #include <perl.h> | |
24cb6d4e | 127 | #include <XSUB.h> |
128 | ||
8ad38b0e | 129 | typedef struct |
130 | { | |
23bce193 | 131 | SV *callback; |
132 | SV *userdata; | |
81b93679 | 133 | xchat_hook *hook; /* required for timers */ |
134 | xchat_context *ctx; /* allow timers to remember their context */ | |
fcca962e | 135 | SV *package; /* need to track the package name when removing hooks |
136 | by returning REMOVE | |
137 | */ | |
21bd2b0c | 138 | unsigned int depth; |
8ad38b0e | 139 | } HookData; |
140 | ||
141 | static PerlInterpreter *my_perl = NULL; | |
23bce193 | 142 | extern void boot_DynaLoader (pTHX_ CV * cv); |
8ad38b0e | 143 | |
6afa2506 | 144 | /* |
24cb6d4e | 145 | this is used for autoload and shutdown callbacks |
6afa2506 | 146 | */ |
147 | static int | |
23bce193 | 148 | execute_perl (SV * function, char *args) |
2322d59b | 149 | { |
23bce193 | 150 | |
151 | int count, ret_value = 1; | |
23bce193 | 152 | |
153 | dSP; | |
154 | ENTER; | |
155 | SAVETMPS; | |
156 | ||
157 | PUSHMARK (SP); | |
158 | XPUSHs (sv_2mortal (newSVpv (args, 0))); | |
159 | PUTBACK; | |
160 | ||
161 | count = call_sv (function, G_EVAL | G_SCALAR); | |
162 | SPAGAIN; | |
542f0294 | 163 | if (SvTRUE (ERRSV)) { |
07e904af | 164 | xchat_printf(ph, "Perl error: %s\n", SvPV_nolen (ERRSV)); |
20485f61 | 165 | if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ |
23bce193 | 166 | } else if (count != 1) { |
167 | xchat_printf (ph, "Perl error: expected 1 value from %s, " | |
07e904af | 168 | "got: %d\n", SvPV_nolen (function), count); |
23bce193 | 169 | } else { |
170 | ret_value = POPi; | |
171 | } | |
23bce193 | 172 | PUTBACK; |
173 | FREETMPS; | |
174 | LEAVE; | |
175 | ||
176 | return ret_value; | |
2322d59b | 177 | } |
178 | ||
d7252261 | 179 | static char * |
180 | get_filename (char *word[], char *word_eol[]) | |
181 | { | |
182 | int len; | |
183 | char *file; | |
184 | ||
185 | len = strlen (word[2]); | |
186 | ||
187 | /* if called as /load "filename.pl" the only difference between word and | |
188 | * word_eol will be the two quotes | |
189 | */ | |
190 | ||
191 | if (strchr (word[2], ' ') != NULL | |
192 | || (strlen (word_eol[2]) - strlen(word[2])) == 2 ) | |
193 | { | |
194 | file = word[2]; | |
195 | } else { | |
196 | file = word_eol[2]; | |
197 | } | |
198 | ||
199 | len = strlen (file); | |
200 | ||
201 | if (len > 3 && strncasecmp (".pl", file + len - 3, 3) == 0) { | |
202 | return file; | |
203 | } | |
204 | ||
205 | return NULL; | |
206 | } | |
207 | ||
20485f61 | 208 | static SV * |
209 | list_item_to_sv ( xchat_list *list, const char *const *fields ) | |
210 | { | |
211 | HV *hash = newHV(); | |
212 | SV *field_value; | |
213 | const char *field; | |
214 | int field_index = 0; | |
215 | const char *field_name; | |
216 | int name_len; | |
217 | ||
218 | while (fields[field_index] != NULL) { | |
219 | field_name = fields[field_index] + 1; | |
220 | name_len = strlen (field_name); | |
221 | ||
222 | switch (fields[field_index][0]) { | |
223 | case 's': | |
224 | field = xchat_list_str (ph, list, field_name); | |
225 | if (field != NULL) { | |
226 | field_value = newSVpvn (field, strlen (field)); | |
227 | } else { | |
228 | field_value = &PL_sv_undef; | |
229 | } | |
230 | break; | |
231 | case 'p': | |
232 | field_value = newSViv (PTR2IV (xchat_list_str (ph, list, | |
233 | field_name))); | |
234 | break; | |
235 | case 'i': | |
236 | field_value = newSVuv (xchat_list_int (ph, list, field_name)); | |
237 | break; | |
238 | case 't': | |
239 | field_value = newSVnv (xchat_list_time (ph, list, field_name)); | |
240 | break; | |
241 | default: | |
242 | field_value = &PL_sv_undef; | |
243 | } | |
244 | hv_store (hash, field_name, name_len, field_value, 0); | |
245 | field_index++; | |
246 | } | |
247 | return sv_2mortal (newRV_noinc ((SV *) hash)); | |
248 | } | |
249 | ||
ed7714f1 | 250 | static AV * |
251 | array2av (char *array[]) | |
252 | { | |
253 | int count = 0; | |
254 | SV *temp = NULL; | |
255 | AV *av = newAV(); | |
256 | sv_2mortal ((SV *)av); | |
257 | ||
258 | for ( | |
259 | count = 1; | |
260 | count < 32 && array[count] != NULL && array[count][0] != 0; | |
261 | count++ | |
262 | ) { | |
263 | temp = newSVpv (array[count], 0); | |
264 | SvUTF8_on (temp); | |
265 | av_push (av, temp); | |
266 | } | |
267 | ||
268 | return av; | |
269 | } | |
270 | ||
20240c10 | 271 | static int |
272 | fd_cb (int fd, int flags, void *userdata) | |
273 | { | |
23bce193 | 274 | HookData *data = (HookData *) userdata; |
168fabc9 | 275 | int retVal = 0; |
276 | int count = 0; | |
23bce193 | 277 | |
278 | dSP; | |
279 | ENTER; | |
280 | SAVETMPS; | |
281 | ||
282 | PUSHMARK (SP); | |
283 | XPUSHs (data->userdata); | |
284 | PUTBACK; | |
285 | ||
168fabc9 | 286 | count = call_sv (data->callback, G_EVAL); |
23bce193 | 287 | SPAGAIN; |
168fabc9 | 288 | |
23bce193 | 289 | if (SvTRUE (ERRSV)) { |
290 | xchat_printf (ph, "Error in fd callback %s", SvPV_nolen (ERRSV)); | |
20485f61 | 291 | if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ |
168fabc9 | 292 | retVal = XCHAT_EAT_ALL; |
293 | } else { | |
294 | if (count != 1) { | |
295 | xchat_print (ph, "Fd handler should only return 1 value."); | |
296 | retVal = XCHAT_EAT_NONE; | |
297 | } else { | |
298 | retVal = POPi; | |
299 | if (retVal == 0) { | |
300 | /* if 0 is returned, the fd is going to get unhooked */ | |
301 | PUSHMARK (SP); | |
302 | XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook)))); | |
303 | PUTBACK; | |
304 | ||
305 | call_pv ("Xchat::unhook", G_EVAL); | |
306 | SPAGAIN; | |
307 | ||
308 | SvREFCNT_dec (data->callback); | |
309 | ||
310 | if (data->userdata) { | |
311 | SvREFCNT_dec (data->userdata); | |
312 | } | |
313 | free (data); | |
314 | } | |
315 | } | |
316 | ||
23bce193 | 317 | } |
318 | ||
319 | PUTBACK; | |
320 | FREETMPS; | |
321 | LEAVE; | |
322 | ||
168fabc9 | 323 | return retVal; |
20240c10 | 324 | } |
e82d7416 | 325 | |
2322d59b | 326 | static int |
327 | timer_cb (void *userdata) | |
328 | { | |
23bce193 | 329 | HookData *data = (HookData *) userdata; |
330 | int retVal = 0; | |
331 | int count = 0; | |
332 | ||
333 | dSP; | |
334 | ENTER; | |
335 | SAVETMPS; | |
336 | ||
337 | PUSHMARK (SP); | |
338 | XPUSHs (data->userdata); | |
339 | PUTBACK; | |
340 | ||
81b93679 | 341 | if (data->ctx) { |
342 | xchat_set_context (ph, data->ctx); | |
343 | } | |
23bce193 | 344 | count = call_sv (data->callback, G_EVAL); |
345 | SPAGAIN; | |
346 | ||
347 | if (SvTRUE (ERRSV)) { | |
348 | xchat_printf (ph, "Error in timer callback %s", SvPV_nolen (ERRSV)); | |
20485f61 | 349 | if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ |
23bce193 | 350 | retVal = XCHAT_EAT_ALL; |
351 | } else { | |
352 | if (count != 1) { | |
353 | xchat_print (ph, "Timer handler should only return 1 value."); | |
354 | retVal = XCHAT_EAT_NONE; | |
355 | } else { | |
356 | retVal = POPi; | |
357 | if (retVal == 0) { | |
358 | /* if 0 is return the timer is going to get unhooked */ | |
359 | PUSHMARK (SP); | |
b8172814 | 360 | XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook)))); |
fcca962e | 361 | XPUSHs (sv_mortalcopy (data->package)); |
23bce193 | 362 | PUTBACK; |
363 | ||
364 | call_pv ("Xchat::unhook", G_EVAL); | |
365 | SPAGAIN; | |
23bce193 | 366 | } |
2322d59b | 367 | } |
23bce193 | 368 | |
369 | } | |
370 | ||
371 | PUTBACK; | |
372 | FREETMPS; | |
373 | LEAVE; | |
374 | ||
375 | return retVal; | |
2322d59b | 376 | } |
377 | ||
378 | static int | |
379 | server_cb (char *word[], char *word_eol[], void *userdata) | |
380 | { | |
23bce193 | 381 | HookData *data = (HookData *) userdata; |
382 | int retVal = 0; | |
383 | int count = 0; | |
384 | ||
23bce193 | 385 | dSP; |
386 | ENTER; | |
387 | SAVETMPS; | |
388 | ||
21bd2b0c | 389 | if (data->depth) |
390 | return XCHAT_EAT_NONE; | |
391 | ||
23bce193 | 392 | /* xchat_printf (ph, */ |
393 | /* "Recieved %d words in server callback", av_len (wd)); */ | |
394 | PUSHMARK (SP); | |
ed7714f1 | 395 | XPUSHs (newRV_noinc ((SV *) array2av (word))); |
396 | XPUSHs (newRV_noinc ((SV *) array2av (word_eol))); | |
23bce193 | 397 | XPUSHs (data->userdata); |
398 | PUTBACK; | |
399 | ||
21bd2b0c | 400 | data->depth++; |
23bce193 | 401 | count = call_sv (data->callback, G_EVAL); |
21bd2b0c | 402 | data->depth--; |
23bce193 | 403 | SPAGAIN; |
404 | if (SvTRUE (ERRSV)) { | |
405 | xchat_printf (ph, "Error in server callback %s", SvPV_nolen (ERRSV)); | |
20485f61 | 406 | if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ |
24cb6d4e | 407 | retVal = XCHAT_EAT_NONE; |
23bce193 | 408 | } else { |
409 | if (count != 1) { | |
410 | xchat_print (ph, "Server handler should only return 1 value."); | |
411 | retVal = XCHAT_EAT_NONE; | |
412 | } else { | |
413 | retVal = POPi; | |
414 | } | |
415 | ||
416 | } | |
417 | ||
418 | PUTBACK; | |
419 | FREETMPS; | |
420 | LEAVE; | |
421 | ||
422 | return retVal; | |
2322d59b | 423 | } |
424 | ||
425 | static int | |
23bce193 | 426 | command_cb (char *word[], char *word_eol[], void *userdata) |
2322d59b | 427 | { |
23bce193 | 428 | HookData *data = (HookData *) userdata; |
429 | int retVal = 0; | |
430 | int count = 0; | |
431 | ||
23bce193 | 432 | dSP; |
433 | ENTER; | |
434 | SAVETMPS; | |
e96a3318 | 435 | |
21bd2b0c | 436 | if (data->depth) |
437 | return XCHAT_EAT_NONE; | |
438 | ||
23bce193 | 439 | /* xchat_printf (ph, "Recieved %d words in command callback", */ |
440 | /* av_len (wd)); */ | |
441 | PUSHMARK (SP); | |
ed7714f1 | 442 | XPUSHs (newRV_noinc ((SV *) array2av (word))); |
443 | XPUSHs (newRV_noinc ((SV *) array2av (word_eol))); | |
23bce193 | 444 | XPUSHs (data->userdata); |
445 | PUTBACK; | |
446 | ||
21bd2b0c | 447 | data->depth++; |
23bce193 | 448 | count = call_sv (data->callback, G_EVAL); |
21bd2b0c | 449 | data->depth--; |
23bce193 | 450 | SPAGAIN; |
451 | if (SvTRUE (ERRSV)) { | |
452 | xchat_printf (ph, "Error in command callback %s", SvPV_nolen (ERRSV)); | |
20485f61 | 453 | if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ |
81e29d6e | 454 | retVal = XCHAT_EAT_XCHAT; |
23bce193 | 455 | } else { |
456 | if (count != 1) { | |
457 | xchat_print (ph, "Command handler should only return 1 value."); | |
458 | retVal = XCHAT_EAT_NONE; | |
459 | } else { | |
460 | retVal = POPi; | |
461 | } | |
462 | ||
463 | } | |
464 | ||
465 | PUTBACK; | |
466 | FREETMPS; | |
467 | LEAVE; | |
468 | ||
469 | return retVal; | |
2322d59b | 470 | } |
471 | ||
472 | static int | |
473 | print_cb (char *word[], void *userdata) | |
474 | { | |
475 | ||
23bce193 | 476 | HookData *data = (HookData *) userdata; |
ed7714f1 | 477 | SV *temp = NULL; |
23bce193 | 478 | int retVal = 0; |
f39679de | 479 | int count = 1; |
480 | int last_index = 31; | |
23bce193 | 481 | /* must be initialized after SAVETMPS */ |
482 | AV *wd = NULL; | |
2322d59b | 483 | |
23bce193 | 484 | dSP; |
485 | ENTER; | |
486 | SAVETMPS; | |
a95b0a76 | 487 | |
21bd2b0c | 488 | if (data->depth) |
489 | return XCHAT_EAT_NONE; | |
490 | ||
23bce193 | 491 | wd = newAV (); |
492 | sv_2mortal ((SV *) wd); | |
a95b0a76 | 493 | |
f39679de | 494 | /* need to scan backwards to find the index of the last element since some |
495 | events such as "DCC Timeout" can have NULL elements in between non NULL | |
496 | elements */ | |
497 | ||
498 | while (last_index >= 0 | |
499 | && (word[last_index] == NULL || word[last_index][0] == 0)) { | |
500 | last_index--; | |
501 | } | |
502 | ||
503 | for (count = 1; count <= last_index; count++) { | |
34e5c39c | 504 | if (word[count] == NULL) { |
f39679de | 505 | av_push (wd, &PL_sv_undef); |
34e5c39c | 506 | } else if (word[count][0] == 0) { |
507 | av_push (wd, newSVpvn ("",0)); | |
f39679de | 508 | } else { |
ed7714f1 | 509 | temp = newSVpv (word[count], 0); |
510 | SvUTF8_on (temp); | |
511 | av_push (wd, temp); | |
f39679de | 512 | } |
23bce193 | 513 | } |
514 | ||
f39679de | 515 | /*xchat_printf (ph, "Recieved %d words in print callback", av_len (wd)+1); */ |
23bce193 | 516 | PUSHMARK (SP); |
517 | XPUSHs (newRV_noinc ((SV *) wd)); | |
518 | XPUSHs (data->userdata); | |
519 | PUTBACK; | |
520 | ||
21bd2b0c | 521 | data->depth++; |
23bce193 | 522 | count = call_sv (data->callback, G_EVAL); |
21bd2b0c | 523 | data->depth--; |
23bce193 | 524 | SPAGAIN; |
525 | if (SvTRUE (ERRSV)) { | |
526 | xchat_printf (ph, "Error in print callback %s", SvPV_nolen (ERRSV)); | |
20485f61 | 527 | if (!SvOK (POPs)) {} /* remove undef from the top of the stack */ |
2322d59b | 528 | retVal = XCHAT_EAT_NONE; |
23bce193 | 529 | } else { |
530 | if (count != 1) { | |
531 | xchat_print (ph, "Print handler should only return 1 value."); | |
532 | retVal = XCHAT_EAT_NONE; | |
533 | } else { | |
534 | retVal = POPi; | |
535 | } | |
536 | ||
537 | } | |
538 | ||
539 | PUTBACK; | |
540 | FREETMPS; | |
541 | LEAVE; | |
542 | ||
543 | return retVal; | |
2322d59b | 544 | } |
545 | ||
546 | /* custom IRC perl functions for scripting */ | |
547 | ||
07a728b6 | 548 | /* Xchat::Internal::register (scriptname, version, desc, shutdowncallback, filename) |
2322d59b | 549 | * |
550 | */ | |
551 | ||
23bce193 | 552 | static |
553 | XS (XS_Xchat_register) | |
2322d59b | 554 | { |
23bce193 | 555 | char *name, *version, *desc, *filename; |
556 | void *gui_entry; | |
557 | dXSARGS; | |
558 | if (items != 4) { | |
559 | xchat_printf (ph, | |
560 | "Usage: Xchat::Internal::register(scriptname, version, desc, filename)"); | |
561 | } else { | |
562 | name = SvPV_nolen (ST (0)); | |
563 | version = SvPV_nolen (ST (1)); | |
564 | desc = SvPV_nolen (ST (2)); | |
565 | filename = SvPV_nolen (ST (3)); | |
566 | ||
567 | gui_entry = xchat_plugingui_add (ph, filename, name, | |
568 | desc, version, NULL); | |
569 | ||
b8172814 | 570 | XSRETURN_IV (PTR2IV (gui_entry)); |
23bce193 | 571 | |
572 | } | |
2322d59b | 573 | } |
574 | ||
575 | ||
576 | /* Xchat::print(output) */ | |
23bce193 | 577 | static |
578 | XS (XS_Xchat_print) | |
2322d59b | 579 | { |
23bce193 | 580 | |
581 | char *text = NULL; | |
582 | ||
583 | dXSARGS; | |
584 | if (items != 1) { | |
585 | xchat_print (ph, "Usage: Xchat::Internal::print(text)"); | |
586 | } else { | |
587 | text = SvPV_nolen (ST (0)); | |
588 | xchat_print (ph, text); | |
589 | } | |
590 | XSRETURN_EMPTY; | |
2322d59b | 591 | } |
592 | ||
23bce193 | 593 | static |
594 | XS (XS_Xchat_emit_print) | |
2322d59b | 595 | { |
23bce193 | 596 | char *event_name; |
597 | int RETVAL; | |
598 | int count; | |
599 | ||
600 | dXSARGS; | |
601 | if (items < 1) { | |
602 | xchat_print (ph, "Usage: Xchat::emit_print(event_name, ...)"); | |
603 | } else { | |
604 | event_name = (char *) SvPV_nolen (ST (0)); | |
605 | RETVAL = 0; | |
606 | ||
607 | /* we need to figure out the number of defined values passed in */ | |
608 | for (count = 0; count < items; count++) { | |
609 | if (!SvOK (ST (count))) { | |
610 | break; | |
611 | } | |
2322d59b | 612 | } |
23bce193 | 613 | |
614 | switch (count) { | |
615 | case 1: | |
616 | RETVAL = xchat_emit_print (ph, event_name, NULL); | |
617 | break; | |
618 | case 2: | |
619 | RETVAL = xchat_emit_print (ph, event_name, | |
620 | SvPV_nolen (ST (1)), NULL); | |
621 | break; | |
622 | case 3: | |
623 | RETVAL = xchat_emit_print (ph, event_name, | |
624 | SvPV_nolen (ST (1)), | |
625 | SvPV_nolen (ST (2)), NULL); | |
626 | break; | |
627 | case 4: | |
628 | RETVAL = xchat_emit_print (ph, event_name, | |
629 | SvPV_nolen (ST (1)), | |
630 | SvPV_nolen (ST (2)), | |
631 | SvPV_nolen (ST (3)), NULL); | |
632 | break; | |
633 | case 5: | |
634 | RETVAL = xchat_emit_print (ph, event_name, | |
635 | SvPV_nolen (ST (1)), | |
636 | SvPV_nolen (ST (2)), | |
637 | SvPV_nolen (ST (3)), | |
638 | SvPV_nolen (ST (4)), NULL); | |
639 | break; | |
640 | ||
641 | } | |
642 | ||
9e555eaa | 643 | XSRETURN_IV (RETVAL); |
23bce193 | 644 | } |
2322d59b | 645 | } |
b4a6891e | 646 | |
647 | static | |
648 | XS (XS_Xchat_send_modes) | |
649 | { | |
650 | AV *p_targets = NULL; | |
651 | int modes_per_line = 0; | |
652 | char sign; | |
653 | char mode; | |
654 | int i = 0; | |
655 | const char **targets; | |
656 | int target_count = 0; | |
657 | SV **elem; | |
658 | ||
659 | dXSARGS; | |
660 | if (items < 3 || items > 4) { | |
661 | xchat_print (ph, | |
662 | "Usage: Xchat::send_modes( targets, sign, mode, modes_per_line)" | |
663 | ); | |
664 | } else { | |
665 | if (SvROK (ST (0))) { | |
666 | p_targets = (AV*) SvRV (ST (0)); | |
667 | target_count = av_len (p_targets) + 1; | |
668 | targets = malloc (target_count * sizeof (char *)); | |
669 | for (i = 0; i < target_count; i++ ) { | |
670 | elem = av_fetch (p_targets, i, 0); | |
671 | ||
672 | if (elem != NULL) { | |
673 | targets[i] = SvPV_nolen (*elem); | |
674 | } else { | |
675 | targets[i] = ""; | |
676 | } | |
677 | } | |
678 | } else{ | |
679 | targets = malloc (sizeof (char *)); | |
680 | targets[0] = SvPV_nolen (ST (0)); | |
681 | target_count = 1; | |
682 | } | |
683 | ||
684 | if (target_count == 0) { | |
685 | XSRETURN_EMPTY; | |
686 | } | |
687 | ||
688 | sign = (SvPV_nolen (ST (1)))[0]; | |
689 | mode = (SvPV_nolen (ST (2)))[0]; | |
690 | ||
691 | if (items == 4 ) { | |
692 | modes_per_line = (int) SvIV (ST (3)); | |
693 | } | |
694 | ||
695 | xchat_send_modes (ph, targets, target_count, modes_per_line, sign, mode); | |
e5d1787d | 696 | free (targets); |
b4a6891e | 697 | } |
698 | } | |
23bce193 | 699 | static |
700 | XS (XS_Xchat_get_info) | |
2322d59b | 701 | { |
ed7714f1 | 702 | SV *temp = NULL; |
23bce193 | 703 | dXSARGS; |
704 | if (items != 1) { | |
705 | xchat_print (ph, "Usage: Xchat::get_info(id)"); | |
706 | } else { | |
707 | SV *id = ST (0); | |
708 | const char *RETVAL; | |
709 | ||
710 | RETVAL = xchat_get_info (ph, SvPV_nolen (id)); | |
711 | if (RETVAL == NULL) { | |
712 | XSRETURN_UNDEF; | |
713 | } | |
ed7714f1 | 714 | |
4ef6cf88 | 715 | if (!strncmp ("win_ptr", SvPV_nolen (id), 7) |
716 | || !strncmp ("gtkwin_ptr", SvPV_nolen (id), 10)) | |
717 | { | |
ed7714f1 | 718 | XSRETURN_IV (PTR2IV (RETVAL)); |
719 | } else { | |
720 | ||
721 | if ( | |
722 | !strncmp ("libdirfs", SvPV_nolen (id), 8) || | |
723 | !strncmp ("xchatdirfs", SvPV_nolen (id), 10) | |
724 | ) { | |
725 | XSRETURN_PV (RETVAL); | |
726 | } else { | |
727 | temp = newSVpv (RETVAL, 0); | |
728 | SvUTF8_on (temp); | |
729 | PUSHMARK (SP); | |
730 | XPUSHs (sv_2mortal (temp)); | |
731 | PUTBACK; | |
ed7714f1 | 732 | } |
733 | } | |
23bce193 | 734 | } |
2322d59b | 735 | } |
736 | ||
f08a857c | 737 | static |
738 | XS (XS_Xchat_context_info) | |
739 | { | |
f08a857c | 740 | const char *const *fields; |
f08a857c | 741 | dXSARGS; |
742 | ||
20485f61 | 743 | if (items > 0 ) { |
744 | xchat_print (ph, "Usage: Xchat::Internal::context_info()"); | |
f08a857c | 745 | } |
20485f61 | 746 | fields = xchat_list_fields (ph, "channels" ); |
747 | XPUSHs (list_item_to_sv (NULL, fields)); | |
f08a857c | 748 | XSRETURN (1); |
749 | } | |
750 | ||
23bce193 | 751 | static |
752 | XS (XS_Xchat_get_prefs) | |
2322d59b | 753 | { |
23bce193 | 754 | const char *str; |
755 | int integer; | |
ed7714f1 | 756 | SV *temp = NULL; |
23bce193 | 757 | dXSARGS; |
758 | if (items != 1) { | |
759 | xchat_print (ph, "Usage: Xchat::get_prefs(name)"); | |
760 | } else { | |
761 | ||
762 | ||
763 | switch (xchat_get_prefs (ph, SvPV_nolen (ST (0)), &str, &integer)) { | |
764 | case 0: | |
765 | XSRETURN_UNDEF; | |
766 | break; | |
767 | case 1: | |
ed7714f1 | 768 | temp = newSVpv (str, 0); |
769 | SvUTF8_on (temp); | |
770 | SP -= items; | |
9b0cec10 | 771 | sp = mark; |
ed7714f1 | 772 | XPUSHs (sv_2mortal (temp)); |
773 | PUTBACK; | |
23bce193 | 774 | break; |
775 | case 2: | |
9e555eaa | 776 | XSRETURN_IV (integer); |
23bce193 | 777 | break; |
778 | case 3: | |
779 | if (integer) { | |
780 | XSRETURN_YES; | |
781 | } else { | |
782 | XSRETURN_NO; | |
783 | } | |
2322d59b | 784 | } |
23bce193 | 785 | } |
2322d59b | 786 | } |
787 | ||
07a728b6 | 788 | /* Xchat::Internal::hook_server(name, priority, callback, userdata) */ |
23bce193 | 789 | static |
790 | XS (XS_Xchat_hook_server) | |
2322d59b | 791 | { |
792 | ||
23bce193 | 793 | char *name; |
794 | int pri; | |
795 | SV *callback; | |
796 | SV *userdata; | |
797 | xchat_hook *hook; | |
798 | HookData *data; | |
799 | ||
800 | dXSARGS; | |
801 | ||
802 | if (items != 4) { | |
803 | xchat_print (ph, | |
804 | "Usage: Xchat::Internal::hook_server(name, priority, callback, userdata)"); | |
805 | } else { | |
806 | name = SvPV_nolen (ST (0)); | |
807 | pri = (int) SvIV (ST (1)); | |
808 | callback = ST (2); | |
809 | userdata = ST (3); | |
810 | data = NULL; | |
811 | data = malloc (sizeof (HookData)); | |
812 | if (data == NULL) { | |
813 | XSRETURN_UNDEF; | |
814 | } | |
815 | ||
816 | data->callback = sv_mortalcopy (callback); | |
817 | SvREFCNT_inc (data->callback); | |
818 | data->userdata = sv_mortalcopy (userdata); | |
819 | SvREFCNT_inc (data->userdata); | |
21bd2b0c | 820 | data->depth = 0; |
fcca962e | 821 | data->package = NULL; |
23bce193 | 822 | hook = xchat_hook_server (ph, name, pri, server_cb, data); |
823 | ||
b8172814 | 824 | XSRETURN_IV (PTR2IV (hook)); |
23bce193 | 825 | } |
2322d59b | 826 | } |
827 | ||
07a728b6 | 828 | /* Xchat::Internal::hook_command(name, priority, callback, help_text, userdata) */ |
23bce193 | 829 | static |
830 | XS (XS_Xchat_hook_command) | |
2322d59b | 831 | { |
23bce193 | 832 | char *name; |
833 | int pri; | |
834 | SV *callback; | |
8e015c1a | 835 | char *help_text = NULL; |
23bce193 | 836 | SV *userdata; |
837 | xchat_hook *hook; | |
838 | HookData *data; | |
839 | ||
840 | dXSARGS; | |
841 | ||
842 | if (items != 5) { | |
843 | xchat_print (ph, | |
844 | "Usage: Xchat::Internal::hook_command(name, priority, callback, help_text, userdata)"); | |
845 | } else { | |
846 | name = SvPV_nolen (ST (0)); | |
847 | pri = (int) SvIV (ST (1)); | |
848 | callback = ST (2); | |
8e015c1a | 849 | |
850 | /* leave the help text has NULL if the help text is undefined to avoid | |
851 | * overriding the default help message for builtin commands */ | |
852 | if (SvOK(ST (3))) { | |
853 | help_text = SvPV_nolen (ST (3)); | |
854 | } | |
855 | ||
23bce193 | 856 | userdata = ST (4); |
857 | data = NULL; | |
858 | ||
859 | data = malloc (sizeof (HookData)); | |
860 | if (data == NULL) { | |
861 | XSRETURN_UNDEF; | |
862 | } | |
863 | ||
864 | data->callback = sv_mortalcopy (callback); | |
865 | SvREFCNT_inc (data->callback); | |
866 | data->userdata = sv_mortalcopy (userdata); | |
867 | SvREFCNT_inc (data->userdata); | |
21bd2b0c | 868 | data->depth = 0; |
fcca962e | 869 | data->package = NULL; |
23bce193 | 870 | hook = xchat_hook_command (ph, name, pri, command_cb, help_text, data); |
871 | ||
b8172814 | 872 | XSRETURN_IV (PTR2IV (hook)); |
23bce193 | 873 | } |
2322d59b | 874 | |
875 | } | |
876 | ||
07a728b6 | 877 | /* Xchat::Internal::hook_print(name, priority, callback, [userdata]) */ |
23bce193 | 878 | static |
879 | XS (XS_Xchat_hook_print) | |
2322d59b | 880 | { |
881 | ||
23bce193 | 882 | char *name; |
883 | int pri; | |
884 | SV *callback; | |
885 | SV *userdata; | |
886 | xchat_hook *hook; | |
887 | HookData *data; | |
888 | dXSARGS; | |
889 | if (items != 4) { | |
890 | xchat_print (ph, | |
891 | "Usage: Xchat::Internal::hook_print(name, priority, callback, userdata)"); | |
892 | } else { | |
893 | name = SvPV_nolen (ST (0)); | |
894 | pri = (int) SvIV (ST (1)); | |
895 | callback = ST (2); | |
896 | data = NULL; | |
897 | userdata = ST (3); | |
898 | ||
899 | data = malloc (sizeof (HookData)); | |
900 | if (data == NULL) { | |
901 | XSRETURN_UNDEF; | |
2322d59b | 902 | } |
903 | ||
23bce193 | 904 | data->callback = sv_mortalcopy (callback); |
905 | SvREFCNT_inc (data->callback); | |
906 | data->userdata = sv_mortalcopy (userdata); | |
907 | SvREFCNT_inc (data->userdata); | |
21bd2b0c | 908 | data->depth = 0; |
fcca962e | 909 | data->package = NULL; |
23bce193 | 910 | hook = xchat_hook_print (ph, name, pri, print_cb, data); |
2322d59b | 911 | |
b8172814 | 912 | XSRETURN_IV (PTR2IV (hook)); |
23bce193 | 913 | } |
2322d59b | 914 | } |
915 | ||
07a728b6 | 916 | /* Xchat::Internal::hook_timer(timeout, callback, userdata) */ |
23bce193 | 917 | static |
918 | XS (XS_Xchat_hook_timer) | |
2322d59b | 919 | { |
23bce193 | 920 | int timeout; |
921 | SV *callback; | |
922 | SV *userdata; | |
923 | xchat_hook *hook; | |
fcca962e | 924 | SV *package; |
23bce193 | 925 | HookData *data; |
926 | ||
927 | dXSARGS; | |
928 | ||
fcca962e | 929 | if (items != 4) { |
23bce193 | 930 | xchat_print (ph, |
fcca962e | 931 | "Usage: Xchat::Internal::hook_timer(timeout, callback, userdata, package)"); |
23bce193 | 932 | } else { |
933 | timeout = (int) SvIV (ST (0)); | |
934 | callback = ST (1); | |
935 | data = NULL; | |
936 | userdata = ST (2); | |
fcca962e | 937 | package = ST (3); |
23bce193 | 938 | |
939 | data = malloc (sizeof (HookData)); | |
940 | if (data == NULL) { | |
941 | XSRETURN_UNDEF; | |
942 | } | |
943 | ||
944 | data->callback = sv_mortalcopy (callback); | |
945 | SvREFCNT_inc (data->callback); | |
946 | data->userdata = sv_mortalcopy (userdata); | |
947 | SvREFCNT_inc (data->userdata); | |
81b93679 | 948 | data->ctx = xchat_get_context (ph); |
fcca962e | 949 | data->package = sv_mortalcopy (package); |
950 | SvREFCNT_inc (data->package); | |
23bce193 | 951 | hook = xchat_hook_timer (ph, timeout, timer_cb, data); |
952 | data->hook = hook; | |
953 | ||
b8172814 | 954 | XSRETURN_IV (PTR2IV (hook)); |
23bce193 | 955 | } |
2322d59b | 956 | } |
957 | ||
07a728b6 | 958 | /* Xchat::Internal::hook_fd(fd, callback, flags, userdata) */ |
23bce193 | 959 | static |
960 | XS (XS_Xchat_hook_fd) | |
20240c10 | 961 | { |
23bce193 | 962 | int fd; |
963 | SV *callback; | |
964 | int flags; | |
965 | SV *userdata; | |
966 | xchat_hook *hook; | |
967 | HookData *data; | |
968 | ||
969 | dXSARGS; | |
970 | ||
971 | if (items != 4) { | |
972 | xchat_print (ph, | |
973 | "Usage: Xchat::Internal::hook_fd(fd, callback, flags, userdata)"); | |
974 | } else { | |
975 | fd = (int) SvIV (ST (0)); | |
976 | callback = ST (1); | |
977 | flags = (int) SvIV (ST (2)); | |
978 | userdata = ST (3); | |
979 | data = NULL; | |
980 | ||
e96a3318 | 981 | #ifdef WIN32 |
982 | if ((flags & XCHAT_FD_NOTSOCKET) == 0) { | |
6f2f2307 | 983 | /* this _get_osfhandle if from win32iop.h in the perl distribution, |
984 | * not the one provided by Windows | |
985 | */ | |
e96a3318 | 986 | fd = _get_osfhandle(fd); |
987 | if (fd < 0) { | |
988 | xchat_print(ph, "Invalid file descriptor"); | |
989 | XSRETURN_UNDEF; | |
990 | } | |
991 | } | |
992 | #endif | |
993 | ||
23bce193 | 994 | data = malloc (sizeof (HookData)); |
995 | if (data == NULL) { | |
996 | XSRETURN_UNDEF; | |
997 | } | |
998 | ||
999 | data->callback = sv_mortalcopy (callback); | |
1000 | SvREFCNT_inc (data->callback); | |
1001 | data->userdata = sv_mortalcopy (userdata); | |
1002 | SvREFCNT_inc (data->userdata); | |
fcca962e | 1003 | data->package = NULL; |
23bce193 | 1004 | hook = xchat_hook_fd (ph, fd, flags, fd_cb, data); |
168fabc9 | 1005 | data->hook = hook; |
23bce193 | 1006 | |
b8172814 | 1007 | XSRETURN_IV (PTR2IV (hook)); |
23bce193 | 1008 | } |
20240c10 | 1009 | } |
e82d7416 | 1010 | |
23bce193 | 1011 | static |
1012 | XS (XS_Xchat_unhook) | |
2322d59b | 1013 | { |
23bce193 | 1014 | xchat_hook *hook; |
1015 | HookData *userdata; | |
1016 | int retCount = 0; | |
1017 | dXSARGS; | |
1018 | if (items != 1) { | |
1019 | xchat_print (ph, "Usage: Xchat::unhook(hook)"); | |
1020 | } else { | |
1021 | hook = INT2PTR (xchat_hook *, SvUV (ST (0))); | |
1022 | userdata = (HookData *) xchat_unhook (ph, hook); | |
1023 | ||
1024 | if (userdata != NULL) { | |
fcca962e | 1025 | if (userdata->callback != NULL) { |
23bce193 | 1026 | SvREFCNT_dec (userdata->callback); |
1027 | } | |
1028 | ||
fcca962e | 1029 | if (userdata->userdata != NULL) { |
23bce193 | 1030 | XPUSHs (sv_mortalcopy (userdata->userdata)); |
1031 | SvREFCNT_dec (userdata->userdata); | |
1032 | retCount = 1; | |
1033 | } | |
fcca962e | 1034 | |
1035 | if (userdata->package != NULL) { | |
1036 | SvREFCNT_dec (userdata->package); | |
1037 | } | |
b61426cb | 1038 | free (userdata); |
23bce193 | 1039 | } |
23bce193 | 1040 | XSRETURN (retCount); |
1041 | } | |
1042 | XSRETURN_EMPTY; | |
2322d59b | 1043 | } |
1044 | ||
07a728b6 | 1045 | /* Xchat::Internal::command(command) */ |
23bce193 | 1046 | static |
1047 | XS (XS_Xchat_command) | |
2322d59b | 1048 | { |
23bce193 | 1049 | char *cmd = NULL; |
2322d59b | 1050 | |
23bce193 | 1051 | dXSARGS; |
1052 | if (items != 1) { | |
1053 | xchat_print (ph, "Usage: Xchat::Internal::command(command)"); | |
1054 | } else { | |
1055 | cmd = SvPV_nolen (ST (0)); | |
1056 | xchat_command (ph, cmd); | |
50f90451 | 1057 | |
23bce193 | 1058 | } |
1059 | XSRETURN_EMPTY; | |
2322d59b | 1060 | } |
1061 | ||
23bce193 | 1062 | static |
1063 | XS (XS_Xchat_find_context) | |
2322d59b | 1064 | { |
23bce193 | 1065 | char *server = NULL; |
1066 | char *chan = NULL; | |
1067 | xchat_context *RETVAL; | |
1068 | ||
1069 | dXSARGS; | |
1070 | if (items > 2) | |
1071 | xchat_print (ph, "Usage: Xchat::find_context ([channel, [server]])"); | |
1072 | { | |
2322d59b | 1073 | |
23bce193 | 1074 | switch (items) { |
1075 | case 0: /* no server name and no channel name */ | |
1076 | /* nothing to do, server and chan are already NULL */ | |
1077 | break; | |
1078 | case 1: /* channel name only */ | |
1079 | /* change channel value only if it is true or 0 */ | |
1080 | /* otherwise leave it as null */ | |
1081 | if (SvTRUE (ST (0)) || SvNIOK (ST (0))) { | |
1082 | chan = SvPV_nolen (ST (0)); | |
1083 | /* xchat_printf( ph, "XSUB - find_context( %s, NULL )", chan ); */ | |
1084 | } | |
1085 | /* else { xchat_print( ph, "XSUB - find_context( NULL, NULL )" ); } */ | |
1086 | /* chan is already NULL */ | |
1087 | break; | |
1088 | case 2: /* server and channel */ | |
1089 | /* change channel value only if it is true or 0 */ | |
1090 | /* otherwise leave it as NULL */ | |
1091 | if (SvTRUE (ST (0)) || SvNIOK (ST (0))) { | |
1092 | chan = SvPV_nolen (ST (0)); | |
1093 | /* xchat_printf( ph, "XSUB - find_context( %s, NULL )", SvPV_nolen(ST(0) )); */ | |
1094 | } | |
1095 | ||
1096 | /* else { xchat_print( ph, "XSUB - 2 arg NULL chan" ); } */ | |
1097 | /* change server value only if it is true or 0 */ | |
1098 | /* otherwise leave it as NULL */ | |
1099 | if (SvTRUE (ST (1)) || SvNIOK (ST (1))) { | |
1100 | server = SvPV_nolen (ST (1)); | |
1101 | /* xchat_printf( ph, "XSUB - find_context( NULL, %s )", SvPV_nolen(ST(1) )); */ | |
1102 | } | |
1103 | /* else { xchat_print( ph, "XSUB - 2 arg NULL server" ); } */ | |
1104 | break; | |
24cb6d4e | 1105 | } |
23bce193 | 1106 | |
1107 | RETVAL = xchat_find_context (ph, server, chan); | |
1108 | if (RETVAL != NULL) { | |
1109 | /* xchat_print (ph, "XSUB - context found"); */ | |
b8172814 | 1110 | XSRETURN_IV (PTR2IV (RETVAL)); |
23bce193 | 1111 | } else { |
1112 | /* xchat_print (ph, "XSUB - context not found"); */ | |
1113 | XSRETURN_UNDEF; | |
24cb6d4e | 1114 | } |
23bce193 | 1115 | } |
2322d59b | 1116 | } |
1117 | ||
23bce193 | 1118 | static |
1119 | XS (XS_Xchat_get_context) | |
2322d59b | 1120 | { |
23bce193 | 1121 | dXSARGS; |
1122 | if (items != 0) { | |
1123 | xchat_print (ph, "Usage: Xchat::get_context()"); | |
1124 | } else { | |
b8172814 | 1125 | XSRETURN_IV (PTR2IV (xchat_get_context (ph))); |
23bce193 | 1126 | } |
2322d59b | 1127 | } |
1128 | ||
23bce193 | 1129 | static |
1130 | XS (XS_Xchat_set_context) | |
2322d59b | 1131 | { |
23bce193 | 1132 | xchat_context *ctx; |
1133 | dXSARGS; | |
1134 | if (items != 1) { | |
1135 | xchat_print (ph, "Usage: Xchat::set_context(ctx)"); | |
1136 | } else { | |
1137 | ctx = INT2PTR (xchat_context *, SvUV (ST (0))); | |
1138 | XSRETURN_IV ((IV) xchat_set_context (ph, ctx)); | |
1139 | } | |
2322d59b | 1140 | } |
1141 | ||
23bce193 | 1142 | static |
1143 | XS (XS_Xchat_nickcmp) | |
2322d59b | 1144 | { |
23bce193 | 1145 | dXSARGS; |
1146 | if (items != 2) { | |
1147 | xchat_print (ph, "Usage: Xchat::nickcmp(s1, s2)"); | |
1148 | } else { | |
1149 | XSRETURN_IV ((IV) xchat_nickcmp (ph, SvPV_nolen (ST (0)), | |
1150 | SvPV_nolen (ST (1)))); | |
1151 | } | |
2322d59b | 1152 | } |
1153 | ||
23bce193 | 1154 | static |
1155 | XS (XS_Xchat_get_list) | |
2322d59b | 1156 | { |
23bce193 | 1157 | SV *name; |
23bce193 | 1158 | xchat_list *list; |
1159 | const char *const *fields; | |
23bce193 | 1160 | int count = 0; /* return value for scalar context */ |
23bce193 | 1161 | dXSARGS; |
1162 | ||
1163 | if (items != 1) { | |
1164 | xchat_print (ph, "Usage: Xchat::get_list(name)"); | |
1165 | } else { | |
1166 | SP -= items; /*remove the argument list from the stack */ | |
1167 | ||
1168 | name = ST (0); | |
1169 | ||
1170 | list = xchat_list_get (ph, SvPV_nolen (name)); | |
1171 | ||
1172 | if (list == NULL) { | |
1173 | XSRETURN_EMPTY; | |
2322d59b | 1174 | } |
23bce193 | 1175 | |
20485f61 | 1176 | if (GIMME_V == G_SCALAR) { |
23bce193 | 1177 | while (xchat_list_next (ph, list)) { |
1178 | count++; | |
1179 | } | |
1180 | xchat_list_free (ph, list); | |
1181 | XSRETURN_IV ((IV) count); | |
1182 | } | |
1183 | ||
1184 | fields = xchat_list_fields (ph, SvPV_nolen (name)); | |
1185 | while (xchat_list_next (ph, list)) { | |
20485f61 | 1186 | XPUSHs (list_item_to_sv (list, fields)); |
24cb6d4e | 1187 | } |
23bce193 | 1188 | xchat_list_free (ph, list); |
1189 | ||
1190 | PUTBACK; | |
1191 | return; | |
1192 | } | |
2322d59b | 1193 | } |
1194 | ||
23bce193 | 1195 | static |
1196 | XS (XS_Xchat_Embed_plugingui_remove) | |
20240c10 | 1197 | { |
23bce193 | 1198 | void *gui_entry; |
1199 | dXSARGS; | |
1200 | if (items != 1) { | |
1201 | xchat_print (ph, "Usage: Xchat::Embed::plugingui_remove(handle)"); | |
1202 | } else { | |
1203 | gui_entry = INT2PTR (void *, SvUV (ST (0))); | |
1204 | xchat_plugingui_remove (ph, gui_entry); | |
1205 | } | |
1206 | XSRETURN_EMPTY; | |
20240c10 | 1207 | } |
1208 | ||
cf392f98 | 1209 | /* xs_init is the second argument perl_parse. As the name hints, it |
23bce193 | 1210 | initializes XS subroutines (see the perlembed manpage) */ |
cf392f98 | 1211 | static void |
1212 | xs_init (pTHX) | |
6afa2506 | 1213 | { |
23bce193 | 1214 | HV *stash; |
1215 | ||
1216 | /* This one allows dynamic loading of perl modules in perl | |
1217 | scripts by the 'use perlmod;' construction */ | |
1218 | newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); | |
1219 | /* load up all the custom IRC perl functions */ | |
1220 | newXS ("Xchat::Internal::register", XS_Xchat_register, __FILE__); | |
1221 | newXS ("Xchat::Internal::hook_server", XS_Xchat_hook_server, __FILE__); | |
1222 | newXS ("Xchat::Internal::hook_command", XS_Xchat_hook_command, __FILE__); | |
1223 | newXS ("Xchat::Internal::hook_print", XS_Xchat_hook_print, __FILE__); | |
1224 | newXS ("Xchat::Internal::hook_timer", XS_Xchat_hook_timer, __FILE__); | |
1225 | newXS ("Xchat::Internal::hook_fd", XS_Xchat_hook_fd, __FILE__); | |
1226 | newXS ("Xchat::Internal::unhook", XS_Xchat_unhook, __FILE__); | |
1227 | newXS ("Xchat::Internal::print", XS_Xchat_print, __FILE__); | |
1228 | newXS ("Xchat::Internal::command", XS_Xchat_command, __FILE__); | |
1229 | newXS ("Xchat::Internal::set_context", XS_Xchat_set_context, __FILE__); | |
1230 | newXS ("Xchat::Internal::get_info", XS_Xchat_get_info, __FILE__); | |
f08a857c | 1231 | newXS ("Xchat::Internal::context_info", XS_Xchat_context_info, __FILE__); |
81d08c09 | 1232 | newXS ("Xchat::Internal::get_list", XS_Xchat_get_list, __FILE__); |
f08a857c | 1233 | |
23bce193 | 1234 | newXS ("Xchat::find_context", XS_Xchat_find_context, __FILE__); |
1235 | newXS ("Xchat::get_context", XS_Xchat_get_context, __FILE__); | |
1236 | newXS ("Xchat::get_prefs", XS_Xchat_get_prefs, __FILE__); | |
1237 | newXS ("Xchat::emit_print", XS_Xchat_emit_print, __FILE__); | |
b4a6891e | 1238 | newXS ("Xchat::send_modes", XS_Xchat_send_modes, __FILE__); |
23bce193 | 1239 | newXS ("Xchat::nickcmp", XS_Xchat_nickcmp, __FILE__); |
23bce193 | 1240 | |
1241 | newXS ("Xchat::Embed::plugingui_remove", XS_Xchat_Embed_plugingui_remove, | |
1242 | __FILE__); | |
1243 | ||
1244 | stash = get_hv ("Xchat::", TRUE); | |
1245 | if (stash == NULL) { | |
1246 | exit (1); | |
1247 | } | |
1248 | ||
1249 | newCONSTSUB (stash, "PRI_HIGHEST", newSViv (XCHAT_PRI_HIGHEST)); | |
1250 | newCONSTSUB (stash, "PRI_HIGH", newSViv (XCHAT_PRI_HIGH)); | |
1251 | newCONSTSUB (stash, "PRI_NORM", newSViv (XCHAT_PRI_NORM)); | |
1252 | newCONSTSUB (stash, "PRI_LOW", newSViv (XCHAT_PRI_LOW)); | |
1253 | newCONSTSUB (stash, "PRI_LOWEST", newSViv (XCHAT_PRI_LOWEST)); | |
1254 | ||
1255 | newCONSTSUB (stash, "EAT_NONE", newSViv (XCHAT_EAT_NONE)); | |
1256 | newCONSTSUB (stash, "EAT_XCHAT", newSViv (XCHAT_EAT_XCHAT)); | |
1257 | newCONSTSUB (stash, "EAT_PLUGIN", newSViv (XCHAT_EAT_PLUGIN)); | |
1258 | newCONSTSUB (stash, "EAT_ALL", newSViv (XCHAT_EAT_ALL)); | |
1259 | newCONSTSUB (stash, "FD_READ", newSViv (XCHAT_FD_READ)); | |
1260 | newCONSTSUB (stash, "FD_WRITE", newSViv (XCHAT_FD_WRITE)); | |
1261 | newCONSTSUB (stash, "FD_EXCEPTION", newSViv (XCHAT_FD_EXCEPTION)); | |
1262 | newCONSTSUB (stash, "FD_NOTSOCKET", newSViv (XCHAT_FD_NOTSOCKET)); | |
1263 | newCONSTSUB (stash, "KEEP", newSViv (1)); | |
1264 | newCONSTSUB (stash, "REMOVE", newSViv (0)); | |
6afa2506 | 1265 | } |
1266 | ||
cf392f98 | 1267 | static void |
1268 | perl_init (void) | |
6afa2506 | 1269 | { |
23bce193 | 1270 | int warn; |
542f0294 | 1271 | int arg_count; |
23bce193 | 1272 | char *perl_args[] = { "", "-e", "0", "-w" }; |
542f0294 | 1273 | char *env[] = { "" }; |
5b0c30d0 | 1274 | static const char xchat_definitions[] = { |
24cb6d4e | 1275 | /* Redefine the $SIG{__WARN__} handler to have XChat |
23bce193 | 1276 | printing warnings in the main window. (TheHobbit) */ |
b00e78a5 | 1277 | #include "xchat.pm.h" |
23bce193 | 1278 | }; |
5b0c30d0 | 1279 | #ifdef OLD_PERL |
1280 | static const char irc_definitions[] = { | |
1281 | #include "irc.pm.h" | |
1282 | }; | |
1283 | #endif | |
6afa2506 | 1284 | #ifdef ENABLE_NLS |
1285 | ||
23bce193 | 1286 | /* Problem is, dynamicaly loaded modules check out the $] |
1287 | var. It appears that in the embedded interpreter we get | |
1288 | 5,00503 as soon as the LC_NUMERIC locale calls for a comma | |
1289 | instead of a point in separating integer and decimal | |
1290 | parts. I realy can't understant why... The following | |
1291 | appears to be an awful workaround... But it'll do until I | |
1292 | (or someone else :)) found the "right way" to solve this | |
1293 | nasty problem. (TheHobbit <thehobbit@altern.org>) */ | |
1294 | ||
1295 | setlocale (LC_NUMERIC, "C"); | |
1296 | ||
6afa2506 | 1297 | #endif |
1298 | ||
542f0294 | 1299 | warn = 0; |
1300 | xchat_get_prefs (ph, "perl_warnings", NULL, &warn); | |
1301 | arg_count = warn ? 4 : 3; | |
1302 | ||
1303 | PERL_SYS_INIT3 (&arg_count, (char ***)&perl_args, (char ***)&env); | |
23bce193 | 1304 | my_perl = perl_alloc (); |
23bce193 | 1305 | perl_construct (my_perl); |
542f0294 | 1306 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
1307 | perl_parse (my_perl, xs_init, arg_count, perl_args, (char **)NULL); | |
6afa2506 | 1308 | |
23bce193 | 1309 | /* |
1310 | Now initialising the perl interpreter by loading the | |
1311 | perl_definition array. | |
1312 | */ | |
2322d59b | 1313 | |
5b0c30d0 | 1314 | eval_pv (xchat_definitions, TRUE); |
1315 | #ifdef OLD_PERL | |
1316 | eval_pv (irc_definitions, TRUE); | |
1317 | #endif | |
2322d59b | 1318 | |
6afa2506 | 1319 | } |
1320 | ||
6afa2506 | 1321 | |
6afa2506 | 1322 | static int |
86ab734c | 1323 | perl_load_file (char *filename) |
6afa2506 | 1324 | { |
7cdb6dbc | 1325 | #ifdef WIN32 |
c9ab747c | 1326 | static HMODULE lib = NULL; |
7cdb6dbc | 1327 | |
23bce193 | 1328 | if (!lib) { |
c9ab747c | 1329 | lib = LoadLibraryA (PERL_DLL); |
23bce193 | 1330 | if (!lib) { |
c9ab747c | 1331 | if (GetLastError () == ERROR_BAD_EXE_FORMAT) |
1332 | /* http://forum.xchat.org/viewtopic.php?t=3277 */ | |
1333 | thread_mbox ("Cannot use this " PERL_DLL "\n\n" | |
1334 | "32-bit ActivePerl is required."); | |
31c37ae7 | 1335 | else { |
1336 | /* a lot of people install this old version */ | |
1337 | lib = LoadLibraryA ("perl56.dll"); | |
1338 | if (lib) { | |
1339 | FreeLibrary (lib); | |
1340 | lib = NULL; | |
1341 | thread_mbox ("Cannot open " PERL_DLL "\n\n" | |
1342 | "You must have ActivePerl 5.8 installed in order to\n" | |
1343 | "run perl scripts.\n\n" | |
1344 | "I have found Perl 5.6, but that is too old."); | |
1345 | } else { | |
1346 | thread_mbox ("Cannot open " PERL_DLL "\n\n" | |
1347 | "You must have ActivePerl 5.8 installed in order to\n" | |
1348 | "run perl scripts.\n\n" | |
1349 | "http://www.activestate.com/ActivePerl/\n\n" | |
1350 | "Make sure perl's bin directory is in your PATH."); | |
1351 | } | |
1352 | } | |
1353 | /* failure */ | |
23bce193 | 1354 | return FALSE; |
1355 | } | |
31c37ae7 | 1356 | |
1357 | /* success */ | |
7cdb6dbc | 1358 | FreeLibrary (lib); |
23bce193 | 1359 | } |
7cdb6dbc | 1360 | #endif |
1361 | ||
23bce193 | 1362 | if (my_perl == NULL) { |
1363 | perl_init (); | |
1364 | } | |
1365 | ||
1366 | return execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::load", 0)), | |
1367 | filename); | |
6afa2506 | 1368 | |
6afa2506 | 1369 | } |
1370 | ||
6afa2506 | 1371 | static void |
1372 | perl_end (void) | |
1373 | { | |
6afa2506 | 1374 | |
23bce193 | 1375 | if (my_perl != NULL) { |
1376 | execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); | |
542f0294 | 1377 | PL_perl_destruct_level = 1; |
23bce193 | 1378 | perl_destruct (my_perl); |
1379 | perl_free (my_perl); | |
542f0294 | 1380 | PERL_SYS_TERM(); |
23bce193 | 1381 | my_perl = NULL; |
1382 | } | |
6afa2506 | 1383 | |
6afa2506 | 1384 | } |
1385 | ||
1386 | static int | |
1387 | perl_command_unloadall (char *word[], char *word_eol[], void *userdata) | |
1388 | { | |
23bce193 | 1389 | if (my_perl != NULL) { |
1390 | execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); | |
1391 | return XCHAT_EAT_XCHAT; | |
1392 | } | |
6afa2506 | 1393 | |
70a2c78a | 1394 | return XCHAT_EAT_XCHAT; |
6afa2506 | 1395 | } |
1396 | ||
33710472 | 1397 | static int |
1398 | perl_command_reloadall (char *word[], char *word_eol[], void *userdata) | |
1399 | { | |
23bce193 | 1400 | if (my_perl != NULL) { |
37db1b74 | 1401 | execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload_all", 0)), ""); |
23bce193 | 1402 | |
1403 | return XCHAT_EAT_XCHAT; | |
2e8e3133 | 1404 | } else { |
1405 | perl_auto_load( NULL ); | |
23bce193 | 1406 | } |
70a2c78a | 1407 | return XCHAT_EAT_XCHAT; |
33710472 | 1408 | } |
1409 | ||
07a728b6 | 1410 | static int |
1411 | perl_command_load (char *word[], char *word_eol[], void *userdata) | |
1412 | { | |
d7252261 | 1413 | char *file = get_filename (word, word_eol); |
23bce193 | 1414 | |
d7252261 | 1415 | if (file != NULL ) |
1416 | { | |
23bce193 | 1417 | perl_load_file (file); |
1418 | return XCHAT_EAT_XCHAT; | |
1419 | } | |
1420 | ||
1421 | return XCHAT_EAT_NONE; | |
07a728b6 | 1422 | } |
1423 | ||
6afa2506 | 1424 | static int |
1425 | perl_command_unload (char *word[], char *word_eol[], void *userdata) | |
1426 | { | |
d7252261 | 1427 | char *file = get_filename (word, word_eol); |
1428 | ||
1429 | if (my_perl != NULL && file != NULL) { | |
1430 | execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload", 0)), file); | |
1431 | return XCHAT_EAT_XCHAT; | |
23bce193 | 1432 | } |
1433 | ||
1434 | return XCHAT_EAT_NONE; | |
6afa2506 | 1435 | } |
1436 | ||
1437 | static int | |
07a728b6 | 1438 | perl_command_reload (char *word[], char *word_eol[], void *userdata) |
6afa2506 | 1439 | { |
d7252261 | 1440 | char *file = get_filename (word, word_eol); |
1441 | ||
1442 | if (my_perl != NULL && file != NULL) { | |
1443 | execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload", 0)), file); | |
1444 | return XCHAT_EAT_XCHAT; | |
23bce193 | 1445 | } |
d7252261 | 1446 | |
70a2c78a | 1447 | return XCHAT_EAT_XCHAT; |
20240c10 | 1448 | } |
968ab822 | 1449 | |
23bce193 | 1450 | void |
1451 | xchat_plugin_get_info (char **name, char **desc, char **version, | |
1452 | void **reserved) | |
723481c2 | 1453 | { |
23bce193 | 1454 | *name = "Perl"; |
1455 | *desc = "Perl scripting interface"; | |
5b0e0598 | 1456 | *version = PACKAGE_VERSION; |
23bce193 | 1457 | if (reserved) |
1458 | *reserved = NULL; | |
723481c2 | 1459 | } |
1460 | ||
1461 | ||
968ab822 | 1462 | /* Reinit safeguard */ |
1463 | ||
1464 | static int initialized = 0; | |
1465 | static int reinit_tried = 0; | |
1466 | ||
6afa2506 | 1467 | int |
23bce193 | 1468 | xchat_plugin_init (xchat_plugin * plugin_handle, char **plugin_name, |
20240c10 | 1469 | char **plugin_desc, char **plugin_version, char *arg) |
6afa2506 | 1470 | { |
23bce193 | 1471 | ph = plugin_handle; |
1472 | ||
1473 | if (initialized != 0) { | |
968ab822 | 1474 | xchat_print (ph, "Perl interface already loaded\n"); |
1475 | reinit_tried++; | |
1476 | return 0; | |
23bce193 | 1477 | } |
1478 | initialized = 1; | |
6afa2506 | 1479 | |
1d0aa18f | 1480 | *plugin_name = "Perl"; |
1481 | *plugin_desc = "Perl scripting interface"; | |
5b0e0598 | 1482 | *plugin_version = PACKAGE_VERSION; |
6afa2506 | 1483 | |
23bce193 | 1484 | xchat_hook_command (ph, "load", XCHAT_PRI_NORM, perl_command_load, 0, 0); |
1485 | xchat_hook_command (ph, "unload", XCHAT_PRI_NORM, perl_command_unload, 0, | |
1486 | 0); | |
1487 | xchat_hook_command (ph, "reload", XCHAT_PRI_NORM, perl_command_reload, 0, | |
1488 | 0); | |
f271b94d | 1489 | xchat_hook_command (ph, "pl_reload", XCHAT_PRI_NORM, perl_command_reload, 0, |
1490 | 0); | |
23bce193 | 1491 | xchat_hook_command (ph, "unloadall", XCHAT_PRI_NORM, |
1492 | perl_command_unloadall, 0, 0); | |
1493 | xchat_hook_command (ph, "reloadall", XCHAT_PRI_NORM, | |
1494 | perl_command_reloadall, 0, 0); | |
6afa2506 | 1495 | |
23bce193 | 1496 | /*perl_init (); */ |
e247cb15 | 1497 | xchat_hook_timer (ph, 0, perl_auto_load, NULL ); |
6afa2506 | 1498 | |
23bce193 | 1499 | xchat_print (ph, "Perl interface loaded\n"); |
968ab822 | 1500 | |
23bce193 | 1501 | return 1; |
6afa2506 | 1502 | } |
1503 | ||
1504 | int | |
23bce193 | 1505 | xchat_plugin_deinit (xchat_plugin * plugin_handle) |
6afa2506 | 1506 | { |
23bce193 | 1507 | if (reinit_tried) { |
968ab822 | 1508 | reinit_tried--; |
1509 | return 1; | |
23bce193 | 1510 | } |
968ab822 | 1511 | |
23bce193 | 1512 | perl_end (); |
6afa2506 | 1513 | |
23bce193 | 1514 | xchat_print (plugin_handle, "Perl interface unloaded\n"); |
968ab822 | 1515 | |
23bce193 | 1516 | return 1; |
6afa2506 | 1517 | } |