comparison: plugins/perl/perl-common.c
plugins/perl/perl-common.c
- changeset 6520
- 5386692555c9
- parent 6508
- 57d1df1ca3a0
- child 6531
- 3fca41d7b411
equal
deleted
inserted
replaced
| 6519:9986601866d5 | 6520:5386692555c9 |
|---|---|
| 1 #include <XSUB.h> | 1 #include "debug.h" |
| 2 #include <EXTERN.h> | |
| 3 #include <perl.h> | |
| 4 #include <glib.h> | |
| 5 | 2 |
| 6 #include "perl-common.h" | 3 #include "perl-common.h" |
| 7 | 4 |
| 8 extern PerlInterpreter *my_perl; | 5 extern PerlInterpreter *my_perl; |
| 9 | 6 |
| 103 p = GINT_TO_POINTER(SvIV(*sv)); | 100 p = GINT_TO_POINTER(SvIV(*sv)); |
| 104 | 101 |
| 105 return p; | 102 return p; |
| 106 } | 103 } |
| 107 | 104 |
| 105 /* | |
| 106 2003/02/06: execute_perl modified by Mark Doliner <mark@kingant.net> | |
| 107 Pass parameters by pushing them onto the stack rather than | |
| 108 passing an array of strings. This way, perl scripts can | |
| 109 modify the parameters and we can get the changed values | |
| 110 and then shoot ourselves. I mean, uh, use them. | |
| 111 | |
| 112 2001/06/14: execute_perl replaced by Martin Persson <mep@passagen.se> | |
| 113 previous use of perl_eval leaked memory, replaced with | |
| 114 a version that uses perl_call instead | |
| 115 | |
| 116 30/11/2002: execute_perl modified by Eric Timme <timothy@voidnet.com> | |
| 117 args changed to char** so that we can have preparsed | |
| 118 arguments again, and many headaches ensued! This essentially | |
| 119 means we replaced one hacked method with a messier hacked | |
| 120 method out of perceived necessity. Formerly execute_perl | |
| 121 required a single char_ptr, and it would insert it into an | |
| 122 array of character pointers and NULL terminate the new array. | |
| 123 Now we have to pass in pre-terminated character pointer arrays | |
| 124 to accomodate functions that want to pass in multiple arguments. | |
| 125 | |
| 126 Previously arguments were preparsed because an argument list | |
| 127 was constructed in the form 'arg one','arg two' and was | |
| 128 executed via a call like &funcname(arglist) (see .59.x), so | |
| 129 the arglist was magically pre-parsed because of the method. | |
| 130 With Martin Persson's change to perl_call we now need to | |
| 131 use a null terminated list of character pointers for arguments | |
| 132 if we wish them to be parsed. Lacking a better way to allow | |
| 133 for both single arguments and many I created a NULL terminated | |
| 134 array in every function that called execute_perl and passed | |
| 135 that list into the function. In the former version a single | |
| 136 character pointer was passed in, and was placed into an array | |
| 137 of character pointers with two elements, with a NULL element | |
| 138 tacked onto the back, but this method no longer seemed prudent. | |
| 139 | |
| 140 Enhancements in the future might be to get rid of pre-declaring | |
| 141 the array sizes? I am not comfortable enough with this | |
| 142 subject to attempt it myself and hope it to stand the test | |
| 143 of time. | |
| 144 */ | |
| 145 int | |
| 146 execute_perl(const char *function, int argc, char **args) | |
| 147 { | |
| 148 int count = 0, i, ret_value = 1; | |
| 149 SV *sv_args[argc]; | |
| 150 STRLEN na; | |
| 151 | |
| 152 /* | |
| 153 * Set up the perl environment, push arguments onto the | |
| 154 * perl stack, then call the given function | |
| 155 */ | |
| 156 dSP; | |
| 157 ENTER; | |
| 158 SAVETMPS; | |
| 159 PUSHMARK(sp); | |
| 160 | |
| 161 for (i = 0; i < argc; i++) { | |
| 162 if (args[i]) { | |
| 163 sv_args[i] = sv_2mortal(newSVpv(args[i], 0)); | |
| 164 XPUSHs(sv_args[i]); | |
| 165 } | |
| 166 } | |
| 167 | |
| 168 PUTBACK; | |
| 169 count = call_pv(function, G_EVAL | G_SCALAR); | |
| 170 SPAGAIN; | |
| 171 | |
| 172 /* | |
| 173 * Check for "die," make sure we have 1 argument, and set our | |
| 174 * return value. | |
| 175 */ | |
| 176 if (SvTRUE(ERRSV)) { | |
| 177 gaim_debug(GAIM_DEBUG_ERROR, "perl", | |
| 178 "Perl function %s exited abnormally: %s\n", | |
| 179 function, SvPV(ERRSV, na)); | |
| 180 POPs; | |
| 181 } | |
| 182 else if (count != 1) { | |
| 183 /* | |
| 184 * This should NEVER happen. G_SCALAR ensures that we WILL | |
| 185 * have 1 parameter. | |
| 186 */ | |
| 187 gaim_debug(GAIM_DEBUG_ERROR, "perl", | |
| 188 "Perl error from %s: expected 1 return value, " | |
| 189 "but got %d\n", function, count); | |
| 190 } | |
| 191 else | |
| 192 ret_value = POPi; | |
| 193 | |
| 194 /* Check for changed arguments */ | |
| 195 for (i = 0; i < argc; i++) { | |
| 196 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) { | |
| 197 /* | |
| 198 * Shizzel. So the perl script changed one of the parameters, | |
| 199 * and we want this change to affect the original parameters. | |
| 200 * args[i] is just a tempory little list of pointers. We don't | |
| 201 * want to free args[i] here because the new parameter doesn't | |
| 202 * overwrite the data that args[i] points to. That is done by | |
| 203 * the function that called execute_perl. I'm not explaining this | |
| 204 * very well. See, it's aggregate... Oh, but if 2 perl scripts | |
| 205 * both modify the data, _that's_ a memleak. This is really kind | |
| 206 * of hackish. I should fix it. Look how long this comment is. | |
| 207 * Holy crap. | |
| 208 */ | |
| 209 args[i] = g_strdup(SvPV(sv_args[i], na)); | |
| 210 } | |
| 211 } | |
| 212 | |
| 213 PUTBACK; | |
| 214 FREETMPS; | |
| 215 LEAVE; | |
| 216 | |
| 217 return ret_value; | |
| 218 } | |
| 219 | |
| 220 |
