Mercurial > pidgin
annotate plugins/perl/perl.c @ 6508:cbd24b37350d
[gaim-migrate @ 7025]
Okay, ready for some breakage again? I rewrote the perl loader plugin. All
old scripts are broken, but the new API will be much better. Currently, you
can access accounts and do debug output, and that's it, but adding support
for new things is much easier. Please don't come after me with pitchforks.
committer: Tailor Script <tailor@pidgin.im>
author | Christian Hammond <chipx86@chipx86.com> |
---|---|
date | Tue, 19 Aug 2003 21:47:36 +0000 |
parents | 70d5122bc3ff |
children | 2e2593d95121 |
rev | line source |
---|---|
5205 | 1 /* |
2 * gaim | |
3 * | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
4 * Copyright (C) 2003 Christian Hammond <chipx86@gnupdate.org> |
5205 | 5 * |
6 * This program is free software; you can redistribute it and/or modify | |
7 * it under the terms of the GNU General Public License as published by | |
8 * the Free Software Foundation; either version 2 of the License, or | |
9 * (at your option) any later version. | |
10 * | |
11 * This program is distributed in the hope that it will be useful, | |
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 * GNU General Public License for more details. | |
15 * | |
16 * You should have received a copy of the GNU General Public License | |
17 * along with this program; if not, write to the Free Software | |
18 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
19 */ | |
6235 | 20 #ifdef HAVE_CONFIG_H |
21 #include <config.h> | |
22 #endif | |
23 | |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
24 #ifdef DEBUG |
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
25 # undef DEBUG |
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
26 #endif |
5205 | 27 |
28 #undef PACKAGE | |
29 | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
30 |
5205 | 31 #define group perl_group |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
32 |
5205 | 33 #ifdef _WIN32 |
34 /* This took me an age to figure out.. without this __declspec(dllimport) | |
35 * will be ignored. | |
36 */ | |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
37 # define HASATTRIBUTE |
5205 | 38 #endif |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
39 |
5205 | 40 #include <EXTERN.h> |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
41 |
5205 | 42 #ifndef _SEM_SEMUN_UNDEFINED |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
43 # define HAS_UNION_SEMUN |
5205 | 44 #endif |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
45 |
5205 | 46 #include <perl.h> |
47 #include <XSUB.h> | |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
48 |
5205 | 49 #ifndef _WIN32 |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
50 # include <sys/mman.h> |
5205 | 51 #endif |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
52 |
5205 | 53 #undef PACKAGE |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
54 |
5205 | 55 #ifndef _WIN32 |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
56 # include <dirent.h> |
5205 | 57 #else |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
58 /* We're using perl's win32 port of this */ |
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
59 # define dirent direct |
5205 | 60 #endif |
61 | |
62 #undef group | |
63 | |
64 /* perl module support */ | |
65 #ifdef OLD_PERL | |
66 extern void boot_DynaLoader _((CV * cv)); | |
67 #else | |
68 extern void boot_DynaLoader _((pTHX_ CV * cv)); /* perl is so wacky */ | |
69 #endif | |
70 | |
71 #undef _ | |
72 #ifdef DEBUG | |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
73 # undef DEBUG |
5205 | 74 #endif |
75 #ifdef _WIN32 | |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
76 # undef pipe |
5205 | 77 #endif |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
78 |
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
79 #include "internal.h" |
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
80 #include "debug.h" |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
81 #include "plugin.h" |
5205 | 82 |
83 #define PERL_PLUGIN_ID "core-perl" | |
84 | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
85 typedef struct |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
86 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
87 GaimPlugin *plugin; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
88 char *load_sub; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
89 char *unload_sub; |
5205 | 90 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
91 } GaimPerlScript; |
5205 | 92 |
93 | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
94 PerlInterpreter *my_perl = NULL; |
5205 | 95 |
96 static void | |
97 #ifdef OLD_PERL | |
98 xs_init() | |
99 #else | |
100 xs_init(pTHX) | |
101 #endif | |
102 { | |
103 char *file = __FILE__; | |
104 | |
105 /* This one allows dynamic loading of perl modules in perl | |
106 scripts by the 'use perlmod;' construction*/ | |
107 newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); | |
108 } | |
109 | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
110 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
111 static void |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
112 perl_init(void) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
113 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
114 /* changed the name of the variable from load_file to |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
115 perl_definitions since now it does much more than defining |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
116 the load_file sub. Moreover, deplaced the initialisation to |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
117 the xs_init function. (TheHobbit)*/ |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
118 char *perl_args[] = { "", "-e", "0", "-w" }; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
119 char perl_definitions[] = |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
120 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
121 /* We use to function one to load a file the other to |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
122 execute the string obtained from the first and holding |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
123 the file conents. This allows to have a realy local $/ |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
124 without introducing temp variables to hold the old |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
125 value. Just a question of style:) */ |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
126 "sub load_file{" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
127 "my $f_name=shift;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
128 "local $/=undef;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
129 "open FH,$f_name or return \"__FAILED__\";" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
130 "$_=<FH>;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
131 "close FH;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
132 "return $_;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
133 "}" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
134 "sub load_n_eval{" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
135 "my $f_name=shift;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
136 "my $strin=load_file($f_name);" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
137 "return 2 if($strin eq \"__FAILED__\");" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
138 "eval $strin;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
139 "if($@){" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
140 /*" #something went wrong\n"*/ |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
141 "GAIM::print(\"Errors loading file $f_name:\\n\",\"$@\");" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
142 "return 1;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
143 "}" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
144 "return 0;" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
145 "}" |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
146 }; |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
147 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
148 my_perl = perl_alloc(); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
149 perl_construct(my_perl); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
150 #ifdef DEBUG |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
151 perl_parse(my_perl, xs_init, 4, perl_args, NULL); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
152 #else |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
153 perl_parse(my_perl, xs_init, 3, perl_args, NULL); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
154 #endif |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
155 #ifdef HAVE_PERL_EVAL_PV |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
156 eval_pv(perl_definitions, TRUE); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
157 #else |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
158 perl_eval_pv(perl_definitions, TRUE); /* deprecated */ |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
159 #endif |
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
160 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
161 perl_run(my_perl); |
5205 | 162 } |
163 | |
164 /* | |
165 2003/02/06: execute_perl modified by Mark Doliner <mark@kingant.net> | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
166 Pass parameters by pushing them onto the stack rather than |
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
167 passing an array of strings. This way, perl scripts can |
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
168 modify the parameters and we can get the changed values |
5205 | 169 and then shoot ourselves. I mean, uh, use them. |
170 | |
171 2001/06/14: execute_perl replaced by Martin Persson <mep@passagen.se> | |
172 previous use of perl_eval leaked memory, replaced with | |
173 a version that uses perl_call instead | |
174 | |
175 30/11/2002: execute_perl modified by Eric Timme <timothy@voidnet.com> | |
176 args changed to char** so that we can have preparsed | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
177 arguments again, and many headaches ensued! This essentially |
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
178 means we replaced one hacked method with a messier hacked |
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
179 method out of perceived necessity. Formerly execute_perl |
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
180 required a single char_ptr, and it would insert it into an |
5205 | 181 array of character pointers and NULL terminate the new array. |
182 Now we have to pass in pre-terminated character pointer arrays | |
183 to accomodate functions that want to pass in multiple arguments. | |
184 | |
185 Previously arguments were preparsed because an argument list | |
186 was constructed in the form 'arg one','arg two' and was | |
187 executed via a call like &funcname(arglist) (see .59.x), so | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
188 the arglist was magically pre-parsed because of the method. |
5205 | 189 With Martin Persson's change to perl_call we now need to |
190 use a null terminated list of character pointers for arguments | |
191 if we wish them to be parsed. Lacking a better way to allow | |
192 for both single arguments and many I created a NULL terminated | |
193 array in every function that called execute_perl and passed | |
194 that list into the function. In the former version a single | |
195 character pointer was passed in, and was placed into an array | |
196 of character pointers with two elements, with a NULL element | |
197 tacked onto the back, but this method no longer seemed prudent. | |
198 | |
199 Enhancements in the future might be to get rid of pre-declaring | |
200 the array sizes? I am not comfortable enough with this | |
201 subject to attempt it myself and hope it to stand the test | |
202 of time. | |
203 */ | |
204 | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
205 static int |
5205 | 206 execute_perl(const char *function, int argc, char **args) |
207 { | |
208 int count = 0, i, ret_value = 1; | |
209 SV *sv_args[argc]; | |
210 STRLEN na; | |
211 | |
212 /* | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
213 * Set up the perl environment, push arguments onto the |
5205 | 214 * perl stack, then call the given function |
215 */ | |
216 dSP; | |
217 ENTER; | |
218 SAVETMPS; | |
219 PUSHMARK(sp); | |
220 | |
221 for (i = 0; i < argc; i++) { | |
222 if (args[i]) { | |
223 sv_args[i] = sv_2mortal(newSVpv(args[i], 0)); | |
224 XPUSHs(sv_args[i]); | |
225 } | |
226 } | |
227 | |
228 PUTBACK; | |
229 count = call_pv(function, G_EVAL | G_SCALAR); | |
230 SPAGAIN; | |
231 | |
232 /* | |
233 * Check for "die," make sure we have 1 argument, and set our | |
234 * return value. | |
235 */ | |
236 if (SvTRUE(ERRSV)) { | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
237 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
238 "Perl function %s exited abnormally: %s\n", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
239 function, SvPV(ERRSV, na)); |
5205 | 240 POPs; |
241 } | |
242 else if (count != 1) { | |
243 /* | |
244 * This should NEVER happen. G_SCALAR ensures that we WILL | |
245 * have 1 parameter. | |
246 */ | |
5227
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
247 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
248 "Perl error from %s: expected 1 return value, " |
6d1707dc8c3d
[gaim-migrate @ 5597]
Christian Hammond <chipx86@chipx86.com>
parents:
5205
diff
changeset
|
249 "but got %d\n", function, count); |
5205 | 250 } |
251 else | |
252 ret_value = POPi; | |
253 | |
254 /* Check for changed arguments */ | |
255 for (i = 0; i < argc; i++) { | |
256 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) { | |
257 /* | |
258 * Shizzel. So the perl script changed one of the parameters, | |
259 * and we want this change to affect the original parameters. | |
260 * args[i] is just a tempory little list of pointers. We don't | |
261 * want to free args[i] here because the new parameter doesn't | |
262 * overwrite the data that args[i] points to. That is done by | |
263 * the function that called execute_perl. I'm not explaining this | |
264 * very well. See, it's aggregate... Oh, but if 2 perl scripts | |
265 * both modify the data, _that's_ a memleak. This is really kind | |
266 * of hackish. I should fix it. Look how long this comment is. | |
267 * Holy crap. | |
268 */ | |
269 args[i] = g_strdup(SvPV(sv_args[i], na)); | |
270 } | |
271 } | |
272 | |
273 PUTBACK; | |
274 FREETMPS; | |
275 LEAVE; | |
276 | |
277 return ret_value; | |
278 } | |
279 | |
280 static void | |
281 perl_end(void) | |
282 { | |
283 if (my_perl != NULL) { | |
284 perl_destruct(my_perl); | |
285 perl_free(my_perl); | |
286 my_perl = NULL; | |
287 } | |
288 } | |
289 | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
290 void |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
291 gaim_perl_callXS(void (*subaddr)(pTHX_ CV *cv), CV *cv, SV **mark) |
5205 | 292 { |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
293 dSP; |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
294 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
295 PUSHMARK(mark); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
296 (*subaddr)(aTHX_ cv); |
5205 | 297 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
298 PUTBACK; |
5205 | 299 } |
300 | |
301 static gboolean | |
302 probe_perl_plugin(GaimPlugin *plugin) | |
303 { | |
304 /* XXX This would be much faster if I didn't create a new | |
305 * PerlInterpreter every time I probed a plugin */ | |
306 PerlInterpreter *prober = perl_alloc(); | |
307 char *argv[] = {"", plugin->path }; | |
308 int count; | |
309 gboolean status = TRUE; | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
310 HV *plugin_info; |
5205 | 311 |
312 perl_construct(prober); | |
5922 | 313 perl_parse(prober, xs_init, 2, argv, NULL); |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
314 perl_run(prober); |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
315 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
316 plugin_info = perl_get_hv("PLUGIN_INFO", FALSE); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
317 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
318 if (plugin_info == NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
319 status = FALSE; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
320 else if (!hv_exists(plugin_info, "perl_api_version", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
321 strlen("perl_api_version")) || |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
322 !hv_exists(plugin_info, "name", strlen("name")) || |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
323 !hv_exists(plugin_info, "load", strlen("load"))) |
5205 | 324 { |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
325 /* Not a valid plugin. */ |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
326 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
327 status = FALSE; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
328 } |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
329 else |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
330 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
331 SV **key; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
332 int perl_api_ver; |
5205 | 333 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
334 key = hv_fetch(plugin_info, "perl_api_version", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
335 strlen("perl_api_version"), 0); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
336 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
337 perl_api_ver = SvIV(*key); |
5205 | 338 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
339 if (perl_api_ver != 2) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
340 status = FALSE; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
341 else |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
342 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
343 GaimPluginInfo *info; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
344 GaimPerlScript *gps; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
345 int len; |
5205 | 346 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
347 gaim_debug(GAIM_DEBUG_INFO, "perl", "Found plugin info\n"); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
348 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
349 info = g_new0(GaimPluginInfo, 1); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
350 gps = g_new0(GaimPerlScript, 1); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
351 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
352 info->api_version = 2; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
353 info->type = GAIM_PLUGIN_STANDARD; |
5205 | 354 |
355 info->dependencies = g_list_append(info->dependencies, | |
356 PERL_PLUGIN_ID); | |
357 | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
358 gps->plugin = plugin; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
359 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
360 /* We know this one exists. */ |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
361 key = hv_fetch(plugin_info, "name", strlen("name"), 0); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
362 info->name = g_strdup(SvPV(*key, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
363 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
364 if ((key = hv_fetch(plugin_info, "url", strlen("url"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
365 info->homepage = g_strdup(SvPV(*key, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
366 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
367 if ((key = hv_fetch(plugin_info, "author", strlen("author"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
368 info->author = g_strdup(SvPV(*key, len)); |
5205 | 369 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
370 if ((key = hv_fetch(plugin_info, "summary", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
371 strlen("summary"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
372 info->summary = g_strdup(SvPV(*key, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
373 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
374 if ((key = hv_fetch(plugin_info, "description", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
375 strlen("description"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
376 info->description = g_strdup(SvPV(*key, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
377 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
378 if ((key = hv_fetch(plugin_info, "version", strlen("version"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
379 info->version = g_strdup(SvPV(*key, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
380 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
381 if ((key = hv_fetch(plugin_info, "load", strlen("load"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
382 gps->load_sub = g_strdup(SvPV(*key, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
383 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
384 if ((key = hv_fetch(plugin_info, "unload", strlen("unload"), 0))) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
385 gps->unload_sub = g_strdup(SvPV(*key, len)); |
5205 | 386 |
387 plugin->info = info; | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
388 info->extra_info = gps; |
5205 | 389 |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
390 status = gaim_plugin_register(plugin); |
5205 | 391 } |
392 } | |
393 | |
394 perl_destruct(prober); | |
395 perl_free(prober); | |
396 | |
397 return status; | |
398 } | |
399 | |
400 static gboolean | |
401 load_perl_plugin(GaimPlugin *plugin) | |
402 { | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
403 GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
404 char *atmp[2] = { plugin->path, NULL }; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
405 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
406 if (gps == NULL || gps->load_sub == NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
407 return FALSE; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
408 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
409 gaim_debug(GAIM_DEBUG_INFO, "perl", "Loading perl script\n"); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
410 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
411 if (my_perl == NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
412 perl_init(); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
413 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
414 plugin->handle = plugin->path; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
415 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
416 execute_perl("load_n_eval", 1, atmp); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
417 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
418 dSP; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
419 ENTER; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
420 SAVETMPS; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
421 PUSHMARK(SP); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
422 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
423 perl_call_pv(gps->load_sub, G_NOARGS | G_EVAL | G_SCALAR); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
424 SPAGAIN; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
425 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
426 if (SvTRUE(ERRSV)) { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
427 int len; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
428 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
429 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
430 "Perl function %s exited abnormally: %s\n", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
431 gps->load_sub, SvPV(ERRSV, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
432 } |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
433 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
434 PUTBACK; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
435 FREETMPS; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
436 LEAVE; |
5205 | 437 |
438 return TRUE; | |
439 } | |
440 | |
441 static gboolean | |
442 unload_perl_plugin(GaimPlugin *plugin) | |
443 { | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
444 GaimPerlScript *gps = (GaimPerlScript *)plugin->info->extra_info; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
445 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
446 if (gps == NULL || gps->unload_sub == NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
447 return FALSE; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
448 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
449 gaim_debug(GAIM_DEBUG_INFO, "perl", "Unloading perl script\n"); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
450 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
451 dSP; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
452 ENTER; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
453 SAVETMPS; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
454 PUSHMARK(SP); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
455 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
456 perl_call_pv(gps->unload_sub, G_NOARGS | G_EVAL | G_SCALAR); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
457 SPAGAIN; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
458 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
459 if (SvTRUE(ERRSV)) { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
460 int len; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
461 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
462 gaim_debug(GAIM_DEBUG_ERROR, "perl", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
463 "Perl function %s exited abnormally: %s\n", |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
464 gps->load_sub, SvPV(ERRSV, len)); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
465 } |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
466 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
467 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
468 PUTBACK; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
469 FREETMPS; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
470 LEAVE; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
471 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
472 gaim_signals_disconnect_by_handle(plugin); |
5205 | 473 |
474 return TRUE; | |
475 } | |
476 | |
477 static void | |
478 destroy_perl_plugin(GaimPlugin *plugin) | |
479 { | |
6508
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
480 if (plugin->info != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
481 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
482 GaimPerlScript *gps; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
483 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
484 if (plugin->info->name != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
485 g_free(plugin->info->name); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
486 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
487 if (plugin->info->version != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
488 g_free(plugin->info->version); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
489 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
490 if (plugin->info->summary != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
491 g_free(plugin->info->summary); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
492 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
493 if (plugin->info->description != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
494 g_free(plugin->info->description); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
495 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
496 if (plugin->info->author != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
497 g_free(plugin->info->author); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
498 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
499 if (plugin->info->homepage != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
500 g_free(plugin->info->homepage); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
501 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
502 gps = (GaimPerlScript *)plugin->info->extra_info; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
503 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
504 if (gps != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
505 { |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
506 if (gps->load_sub != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
507 g_free(gps->load_sub); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
508 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
509 if (gps->unload_sub != NULL) |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
510 g_free(gps->unload_sub); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
511 |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
512 g_free(gps); |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
513 plugin->info->extra_info = NULL; |
cbd24b37350d
[gaim-migrate @ 7025]
Christian Hammond <chipx86@chipx86.com>
parents:
6485
diff
changeset
|
514 } |
5205 | 515 } |
516 } | |
517 | |
518 static gboolean | |
519 plugin_unload(GaimPlugin *plugin) | |
520 { | |
521 perl_end(); | |
522 | |
523 return TRUE; | |
524 } | |
525 | |
526 static GaimPluginLoaderInfo loader_info = | |
527 { | |
528 NULL, /**< exts */ | |
529 | |
530 probe_perl_plugin, /**< probe */ | |
531 load_perl_plugin, /**< load */ | |
532 unload_perl_plugin, /**< unload */ | |
6485
70d5122bc3ff
[gaim-migrate @ 6999]
Christian Hammond <chipx86@chipx86.com>
parents:
6371
diff
changeset
|
533 destroy_perl_plugin /**< destroy */ |
5205 | 534 }; |
535 | |
536 static GaimPluginInfo info = | |
537 { | |
538 2, /**< api_version */ | |
539 GAIM_PLUGIN_LOADER, /**< type */ | |
540 NULL, /**< ui_requirement */ | |
541 0, /**< flags */ | |
542 NULL, /**< dependencies */ | |
543 GAIM_PRIORITY_DEFAULT, /**< priority */ | |
544 | |
545 PERL_PLUGIN_ID, /**< id */ | |
546 N_("Perl Plugin Loader"), /**< name */ | |
547 VERSION, /**< version */ | |
548 N_("Provides support for loading perl plugins."), /**< summary */ | |
549 N_("Provides support for loading perl plugins."), /**< description */ | |
550 "Christian Hammond <chipx86@gnupdate.org>", /**< author */ | |
6371
8f94cce8faa5
[gaim-migrate @ 6876]
Christian Hammond <chipx86@chipx86.com>
parents:
6235
diff
changeset
|
551 GAIM_WEBSITE, /**< homepage */ |
5205 | 552 |
553 NULL, /**< load */ | |
554 plugin_unload, /**< unload */ | |
555 NULL, /**< destroy */ | |
556 | |
557 NULL, /**< ui_info */ | |
558 &loader_info /**< extra_info */ | |
559 }; | |
560 | |
561 static void | |
5872
059d95c67cda
[gaim-migrate @ 6304]
Christian Hammond <chipx86@chipx86.com>
parents:
5775
diff
changeset
|
562 init_plugin(GaimPlugin *plugin) |
5205 | 563 { |
564 loader_info.exts = g_list_append(loader_info.exts, "pl"); | |
565 } | |
566 | |
6063 | 567 GAIM_INIT_PLUGIN(perl, init_plugin, info) |