36 |
t_weechat_plugin *perl_plugin; |
t_weechat_plugin *perl_plugin; |
37 |
|
|
38 |
t_plugin_script *perl_scripts = NULL; |
t_plugin_script *perl_scripts = NULL; |
39 |
t_plugin_script *current_perl_script = NULL; |
t_plugin_script *perl_current_script = NULL; |
40 |
|
char *perl_current_script_filename = NULL; |
|
static PerlInterpreter *my_perl = NULL; |
|
41 |
|
|
42 |
extern void boot_DynaLoader (pTHX_ CV* cv); |
extern void boot_DynaLoader (pTHX_ CV* cv); |
43 |
|
|
|
|
|
44 |
/* |
/* |
45 |
* weechat_perl_exec: execute a Perl script |
* weechat_perl_exec: execute a Perl script |
46 |
*/ |
*/ |
59 |
/* make gcc happy */ |
/* make gcc happy */ |
60 |
(void) script; |
(void) script; |
61 |
|
|
62 |
|
PERL_SET_CONTEXT (script->interpreter); |
63 |
|
|
64 |
dSP; |
dSP; |
65 |
ENTER; |
ENTER; |
66 |
SAVETMPS; |
SAVETMPS; |
71 |
argv[0] = server; |
argv[0] = server; |
72 |
argv[1] = arguments; |
argv[1] = arguments; |
73 |
argv[2] = NULL; |
argv[2] = NULL; |
74 |
|
|
75 |
count = perl_call_argv (function, G_EVAL | G_SCALAR, argv); |
count = perl_call_argv (function, G_EVAL | G_SCALAR, argv); |
76 |
|
|
77 |
SPAGAIN; |
SPAGAIN; |
78 |
|
|
79 |
sv = GvSV (gv_fetchpv ("@", TRUE, SVt_PV)); |
sv = GvSV (gv_fetchpv ("@", TRUE, SVt_PV)); |
160 |
} |
} |
161 |
|
|
162 |
/* register script */ |
/* register script */ |
163 |
current_perl_script = weechat_script_add (perl_plugin, |
perl_current_script = weechat_script_add (perl_plugin, |
164 |
&perl_scripts, |
&perl_scripts, |
165 |
"", |
"", |
166 |
name, version, shutdown_func, |
name, version, shutdown_func, |
167 |
description); |
description); |
168 |
if (current_perl_script) |
if (perl_current_script) |
169 |
{ |
{ |
170 |
perl_plugin->printf_server (perl_plugin, |
perl_plugin->printf_server (perl_plugin, |
171 |
"Perl: registered script \"%s\", " |
"Perl: registered script \"%s\", " |
310 |
|
|
311 |
name = SvPV (ST (0), integer); |
name = SvPV (ST (0), integer); |
312 |
function = SvPV (ST (1), integer); |
function = SvPV (ST (1), integer); |
313 |
perl_plugin->msg_handler_add (perl_plugin, name, |
|
314 |
weechat_perl_handler, function, |
if (perl_current_script) |
315 |
(void *)current_perl_script); |
perl_plugin->msg_handler_add (perl_plugin, name, |
316 |
|
weechat_perl_handler, function, |
317 |
|
(void *)perl_current_script); |
318 |
|
else |
319 |
|
{ |
320 |
|
perl_plugin->printf_server (perl_plugin, |
321 |
|
"Perl error: unable to add message handler, " |
322 |
|
"script not initialized"); |
323 |
|
XSRETURN_NO; |
324 |
|
} |
325 |
|
|
326 |
XSRETURN_YES; |
XSRETURN_YES; |
327 |
} |
} |
328 |
|
|
353 |
arguments = (items >= 4) ? SvPV (ST (3), integer) : NULL; |
arguments = (items >= 4) ? SvPV (ST (3), integer) : NULL; |
354 |
arguments_description = (items >= 5) ? SvPV (ST (4), integer) : NULL; |
arguments_description = (items >= 5) ? SvPV (ST (4), integer) : NULL; |
355 |
|
|
356 |
perl_plugin->cmd_handler_add (perl_plugin, |
if (perl_current_script) |
357 |
command, |
perl_plugin->cmd_handler_add (perl_plugin, |
358 |
description, |
command, |
359 |
arguments, |
description, |
360 |
arguments_description, |
arguments, |
361 |
weechat_perl_handler, |
arguments_description, |
362 |
function, |
weechat_perl_handler, |
363 |
(void *)current_perl_script); |
function, |
364 |
|
(void *)perl_current_script); |
365 |
|
else |
366 |
|
{ |
367 |
|
perl_plugin->printf_server (perl_plugin, |
368 |
|
"Perl error: unable to add command handler, " |
369 |
|
"script not initialized"); |
370 |
|
XSRETURN_NO; |
371 |
|
} |
372 |
|
|
373 |
XSRETURN_YES; |
XSRETURN_YES; |
374 |
} |
} |
375 |
|
|
537 |
int |
int |
538 |
weechat_perl_load (t_weechat_plugin *plugin, char *filename) |
weechat_perl_load (t_weechat_plugin *plugin, char *filename) |
539 |
{ |
{ |
540 |
|
FILE *fp; |
541 |
|
PerlInterpreter *perl_current_interpreter; |
542 |
|
char *perl_args[] = { "", "" }; |
543 |
|
|
544 |
plugin->printf_server (plugin, "Loading Perl script \"%s\"", filename); |
plugin->printf_server (plugin, "Loading Perl script \"%s\"", filename); |
545 |
return weechat_perl_exec (plugin, NULL, "wee_perl_load_eval_file", filename, ""); |
|
546 |
|
if ((fp = fopen (filename, "r")) == NULL) |
547 |
|
{ |
548 |
|
plugin->printf_server (plugin, |
549 |
|
"Perl error: unable to open file \"%s\"", |
550 |
|
filename); |
551 |
|
return 0; |
552 |
|
} |
553 |
|
|
554 |
|
perl_current_script = NULL; |
555 |
|
|
556 |
|
perl_current_interpreter = perl_alloc(); |
557 |
|
|
558 |
|
if (perl_current_interpreter == NULL) |
559 |
|
{ |
560 |
|
plugin->printf_server (plugin, |
561 |
|
"Perl error: unable to create new sub-interpreter"); |
562 |
|
fclose (fp); |
563 |
|
return 0; |
564 |
|
} |
565 |
|
|
566 |
|
PERL_SET_CONTEXT(perl_current_interpreter); |
567 |
|
perl_construct(perl_current_interpreter); |
568 |
|
|
569 |
|
perl_args[1] = filename; |
570 |
|
|
571 |
|
if ( perl_parse (perl_current_interpreter, weechat_perl_xs_init, 2, perl_args, NULL) != 0 ) |
572 |
|
{ |
573 |
|
plugin->printf_server (plugin, |
574 |
|
"Perl error: unable to parse file \"%s\"", |
575 |
|
filename); |
576 |
|
perl_destruct (perl_current_interpreter); |
577 |
|
perl_free (perl_current_interpreter); |
578 |
|
fclose (fp); |
579 |
|
return 0; |
580 |
|
} |
581 |
|
|
582 |
|
if ( perl_run (perl_current_interpreter) ) |
583 |
|
{ |
584 |
|
plugin->printf_server (plugin, |
585 |
|
"Perl error: unable to run file \"%s\"", |
586 |
|
filename); |
587 |
|
perl_destruct (perl_current_interpreter); |
588 |
|
perl_free (perl_current_interpreter); |
589 |
|
/* if script was registered, removing from list */ |
590 |
|
if (perl_current_script != NULL) |
591 |
|
weechat_script_remove (plugin, &perl_scripts, perl_current_script); |
592 |
|
fclose (fp); |
593 |
|
return 0; |
594 |
|
} |
595 |
|
|
596 |
|
eval_pv ("$SIG{__WARN__} = sub { weechat::print \"$_[0]\", \"\"; };", TRUE); |
597 |
|
|
598 |
|
perl_current_script_filename = strdup (filename); |
599 |
|
|
600 |
|
fclose (fp); |
601 |
|
free (perl_current_script_filename); |
602 |
|
|
603 |
|
if (perl_current_script == NULL) |
604 |
|
{ |
605 |
|
plugin->printf_server (plugin, |
606 |
|
"Perl error: function \"register\" not found " |
607 |
|
"in file \"%s\"", |
608 |
|
filename); |
609 |
|
perl_destruct (perl_current_interpreter); |
610 |
|
perl_free (perl_current_interpreter); |
611 |
|
return 0; |
612 |
|
} |
613 |
|
|
614 |
|
perl_current_script->interpreter = (PerlInterpreter *) perl_current_interpreter; |
615 |
|
|
616 |
|
return 1; |
617 |
} |
} |
618 |
|
|
619 |
/* |
/* |
623 |
void |
void |
624 |
weechat_perl_unload (t_weechat_plugin *plugin, t_plugin_script *script) |
weechat_perl_unload (t_weechat_plugin *plugin, t_plugin_script *script) |
625 |
{ |
{ |
626 |
if (script->shutdown_func && script->shutdown_func[0]) |
plugin->printf_server (plugin, |
627 |
weechat_perl_exec (plugin, script, script->shutdown_func, "", ""); |
"Unloading Perl script \"%s\"", |
628 |
|
script->name); |
629 |
|
|
630 |
|
if (script->shutdown_func[0]) |
631 |
|
weechat_perl_exec (plugin, script, script->shutdown_func, "", ""); |
632 |
|
|
633 |
|
PERL_SET_CONTEXT (script->interpreter); |
634 |
|
perl_destruct (script->interpreter); |
635 |
|
perl_free (script->interpreter); |
636 |
|
|
637 |
weechat_script_remove (plugin, &perl_scripts, script); |
weechat_script_remove (plugin, &perl_scripts, script); |
638 |
} |
} |
639 |
|
|
640 |
/* |
/* |
641 |
|
* weechat_perl_unload_name: unload a Perl script by name |
642 |
|
*/ |
643 |
|
|
644 |
|
void |
645 |
|
weechat_perl_unload_name (t_weechat_plugin *plugin, char *name) |
646 |
|
{ |
647 |
|
t_plugin_script *ptr_script; |
648 |
|
|
649 |
|
ptr_script = weechat_script_search (plugin, &perl_scripts, name); |
650 |
|
if (ptr_script) |
651 |
|
{ |
652 |
|
weechat_perl_unload (plugin, ptr_script); |
653 |
|
plugin->printf_server (plugin, |
654 |
|
"Perl script \"%s\" unloaded", |
655 |
|
name); |
656 |
|
} |
657 |
|
else |
658 |
|
{ |
659 |
|
plugin->printf_server (plugin, |
660 |
|
"Perl error: script \"%s\" not loaded", |
661 |
|
name); |
662 |
|
} |
663 |
|
} |
664 |
|
|
665 |
|
/* |
666 |
* weechat_perl_unload_all: unload all Perl scripts |
* weechat_perl_unload_all: unload all Perl scripts |
667 |
*/ |
*/ |
668 |
|
|
802 |
if (path_script) |
if (path_script) |
803 |
free (path_script); |
free (path_script); |
804 |
} |
} |
805 |
|
else if (plugin->ascii_strcasecmp (plugin, argv[0], "unload") == 0) |
806 |
|
{ |
807 |
|
/* unload Perl script */ |
808 |
|
weechat_perl_unload_name (plugin, argv[1]); |
809 |
|
} |
810 |
else |
else |
811 |
{ |
{ |
812 |
plugin->printf_server (plugin, |
plugin->printf_server (plugin, |
832 |
int |
int |
833 |
weechat_plugin_init (t_weechat_plugin *plugin) |
weechat_plugin_init (t_weechat_plugin *plugin) |
834 |
{ |
{ |
|
char *perl_args[] = { "", "-e", "0" }; |
|
|
/* Following Perl code is extracted/modified from X-Chat IRC client */ |
|
|
/* X-Chat is (c) 1998-2005 Peter Zelezny */ |
|
|
char *weechat_perl_func = |
|
|
{ |
|
|
"sub wee_perl_load_file" |
|
|
"{" |
|
|
" my $filename = shift;" |
|
|
" local $/ = undef;" |
|
|
" open FILE, $filename or return \"__WEECHAT_ERROR__\";" |
|
|
" $_ = <FILE>;" |
|
|
" close FILE;" |
|
|
" return $_;" |
|
|
"}" |
|
|
"sub wee_perl_load_eval_file" |
|
|
"{" |
|
|
" my $filename = shift;" |
|
|
" my $content = wee_perl_load_file ($filename);" |
|
|
" if ($content eq \"__WEECHAT_ERROR__\")" |
|
|
" {" |
|
|
" weechat::print \"Perl error: script '$filename' not found.\", \"\";" |
|
|
" return 1;" |
|
|
" }" |
|
|
" eval $content;" |
|
|
" if ($@)" |
|
|
" {" |
|
|
" weechat::print \"Perl error: unable to load script '$filename':\", \"\";" |
|
|
" weechat::print \"$@\";" |
|
|
" return 2;" |
|
|
" }" |
|
|
" return 0;" |
|
|
"}" |
|
|
"$SIG{__WARN__} = sub { weechat::print \"$_[0]\", \"\"; };" |
|
|
}; |
|
|
|
|
835 |
perl_plugin = plugin; |
perl_plugin = plugin; |
836 |
|
|
837 |
plugin->printf_server (plugin, "Loading Perl module \"weechat\""); |
plugin->printf_server (plugin, "Loading Perl module \"weechat\""); |
838 |
|
|
|
my_perl = perl_alloc (); |
|
|
if (!my_perl) |
|
|
{ |
|
|
plugin->printf_server (plugin, |
|
|
"Perl error: unable to initialize Perl"); |
|
|
return 0; |
|
|
} |
|
|
perl_construct (my_perl); |
|
|
perl_parse (my_perl, weechat_perl_xs_init, 3, perl_args, NULL); |
|
|
eval_pv (weechat_perl_func, TRUE); |
|
|
|
|
839 |
plugin->cmd_handler_add (plugin, "perl", |
plugin->cmd_handler_add (plugin, "perl", |
840 |
"list/load/unload Perl scripts", |
"list/load/unload Perl scripts", |
841 |
"[load filename] | [autoload] | [reload] | [unload]", |
"[load filename] | [autoload] | [reload] | [unload]", |
862 |
/* unload all scripts */ |
/* unload all scripts */ |
863 |
weechat_perl_unload_all (plugin); |
weechat_perl_unload_all (plugin); |
864 |
|
|
|
/* free Perl interpreter */ |
|
|
if (my_perl) |
|
|
{ |
|
|
perl_destruct (my_perl); |
|
|
perl_free (my_perl); |
|
|
my_perl = NULL; |
|
|
} |
|
|
|
|
865 |
perl_plugin->printf_server (perl_plugin, |
perl_plugin->printf_server (perl_plugin, |
866 |
"Perl plugin ended"); |
"Perl plugin ended"); |
867 |
} |
} |