Mercurial > pidgin3 / file comparison

comparison: plugins/perl/perl-common.c

plugins/perl/perl-common.c

changeset 6566
61eb35202526
parent 6531
3fca41d7b411
child 6897
d0f925f4f7c1
equal deleted inserted replaced
6565:e040ef0c6ce8 6566:61eb35202526
1 #include "debug.h" 1 #include "debug.h"
2 #include "value.h"
2 3
3 #include "perl-common.h" 4 #include "perl-common.h"
4 5
5 extern PerlInterpreter *my_perl; 6 extern PerlInterpreter *my_perl;
6 7
33 34
34 return sv; 35 return sv;
35 } 36 }
36 37
37 SV * 38 SV *
39 newSVGChar(const char *str)
40 {
41 SV *sv;
42
43 if (str == NULL)
44 return &PL_sv_undef;
45
46 sv = newSVpv(str, 0);
47 SvUTF8_on(sv);
48
49 return sv;
50 }
51
52 SV *
38 gaim_perl_bless_object(void *object, const char *stash_name) 53 gaim_perl_bless_object(void *object, const char *stash_name)
39 { 54 {
40 HV *stash; 55 HV *stash;
41 HV *hv; 56 HV *hv;
42 57
49 64
50 hv = newHV(); 65 hv = newHV();
51 hv_store(hv, "_gaim", 5, create_sv_ptr(object), 0); 66 hv_store(hv, "_gaim", 5, create_sv_ptr(object), 0);
52 67
53 return sv_bless(newRV_noinc((SV *)hv), stash); 68 return sv_bless(newRV_noinc((SV *)hv), stash);
54
55 // return sv_bless(create_sv_ptr(object), gv_stashpv(stash, 1));
56 // return create_sv_ptr(object);
57
58 // dXSARGS;
59
60 // return sv_setref_pv(ST(0), "Gaim::Account", create_sv_ptr(object));
61 } 69 }
62 70
63 gboolean 71 gboolean
64 gaim_perl_is_ref_object(SV *o) 72 gaim_perl_is_ref_object(SV *o)
65 { 73 {
214 LEAVE; 222 LEAVE;
215 223
216 return ret_value; 224 return ret_value;
217 } 225 }
218 226
219 227 #if 0
228 gboolean
229 gaim_perl_value_from_sv(GaimValue *value, SV *sv)
230 {
231 switch (gaim_value_get_type(value))
232 {
233 case GAIM_TYPE_CHAR:
234 if ((tmp = SvGChar(sv)) != NULL)
235 gaim_value_set_char(value, tmp[0]);
236 else
237 return FALSE;
238 break;
239
240 case GAIM_TYPE_UCHAR:
241 if ((tmp = SvPV_nolen(sv)) != NULL)
242 gaim_value_set_uchar(value, tmp[0]);
243 else
244 return FALSE;
245 break;
246
247 case GAIM_TYPE_BOOLEAN:
248 gaim_value_set_boolean(value, SvTRUE(sv));
249 break;
250
251 case GAIM_TYPE_INT:
252 gaim_value_set_int(value, SvIV(sv));
253 break;
254
255 case GAIM_TYPE_UINT:
256 gaim_value_set_uint(value, SvIV(sv));
257 break;
258
259 case GAIM_TYPE_LONG:
260 gaim_value_set_long(value, SvIV(sv));
261 break;
262
263 case GAIM_TYPE_ULONG:
264 gaim_value_set_ulong(value, SvIV(sv));
265 break;
266
267 case GAIM_TYPE_INT64:
268 gaim_value_set_int64(value, SvIV(sv));
269 break;
270
271 case GAIM_TYPE_UINT64:
272 gaim_value_set_uint64(value, SvIV(sv));
273 break;
274
275 case GAIM_TYPE_STRING:
276 gaim_value_set_string(value, SvGChar(sv));
277 break;
278
279 case GAIM_TYPE_POINTER:
280 gaim_value_set_pointer(value, (void *)SvIV(sv));
281 break;
282
283 case GAIM_TYPE_BOXED:
284 if (!strcmp(gaim_value_get_specific_type(value), "SV"))
285 gaim_value_set_boxed(value, (sv == &PL_sv_undef ? NULL : sv));
286 else
287 gaim_value_set_boxed(value, sv);
288 break;
289
290 default:
291 return FALSE;
292 }
293
294 return TRUE;
295 }
296
297 SV *
298 gaim_perl_sv_from_value(const GaimValue *value, va_list list)
299 {
300 switch (gaim_value_get_type(value))
301 {
302 case GAIM_TYPE_BOOLEAN:
303 return newSViv(gaim_value_get_boolean(value));
304 break;
305
306 case GAIM_TYPE_INT:
307 return newSViv(gaim_value_get_int(value));
308 break;
309
310 case GAIM_TYPE_UINT:
311 return newSVuv(gaim_value_get_uint(value));
312 break;
313
314 case GAIM_TYPE_LONG:
315 return newSViv(gaim_value_get_long(value));
316 break;
317
318 case GAIM_TYPE_ULONG:
319 return newSVuv(gaim_value_get_ulong(value));
320 break;
321
322 case GAIM_TYPE_INT64:
323 return newSViv(gaim_value_get_int64(value));
324 break;
325
326 case GAIM_TYPE_UINT64:
327 return newSVuv(gaim_value_get_int64(value));
328 break;
329
330 case GAIM_TYPE_STRING:
331 return newSVGChar(gaim_value_get_string(value));
332 break;
333
334 case GAIM_TYPE_POINTER:
335 return newSViv((IV)gaim_value_get_pointer(value));
336 break;
337
338 case GAIM_TYPE_BOXED:
339 if (!strcmp(gaim_value_get_specific_type(value), "SV"))
340 {
341 SV *sv = (SV *)gaim_perl_get_boxed(value);
342
343 return (sv == NULL ? &PL_sv_undef : sv);
344 }
345
346 /* Uh.. I dunno. Try this? */
347 return sv_2mortal(gaim_perl_bless_object(
348 gaim_perl_get_boxed(value),
349 gaim_value_get_specific_type(value)));
350
351 default:
352 return FALSE;
353 }
354
355 return TRUE;
356 }
357 #endif
358
359 static SV *
360 gaim_perl_sv_from_subtype(const GaimValue *value, void *arg)
361 {
362 const char *stash = NULL;
363
364 switch (gaim_value_get_subtype(value))
365 {
366 case GAIM_SUBTYPE_ACCOUNT:
367 stash = "Gaim::Account";
368 break;
369
370 default:
371 stash = "Gaim"; /* ? */
372 }
373
374 return sv_2mortal(gaim_perl_bless_object(arg, stash));
375 }
376
377 SV *
378 gaim_perl_sv_from_vargs(const GaimValue *value, va_list args)
379 {
380 switch (gaim_value_get_type(value))
381 {
382 case GAIM_TYPE_SUBTYPE:
383 return gaim_perl_sv_from_subtype(value, va_arg(args, void *));
384
385 case GAIM_TYPE_BOOLEAN:
386 return newSViv(va_arg(args, gboolean));
387
388 case GAIM_TYPE_INT:
389 return newSViv(va_arg(args, int));
390
391 case GAIM_TYPE_UINT:
392 return newSVuv(va_arg(args, unsigned int));
393
394 case GAIM_TYPE_LONG:
395 return newSViv(va_arg(args, long));
396
397 case GAIM_TYPE_ULONG:
398 return newSVuv(va_arg(args, unsigned long));
399
400 case GAIM_TYPE_INT64:
401 return newSViv(va_arg(args, gint64));
402
403 case GAIM_TYPE_UINT64:
404 return newSVuv(va_arg(args, guint64));
405
406 case GAIM_TYPE_STRING:
407 return newSVGChar(va_arg(args, char *));
408
409 case GAIM_TYPE_POINTER:
410 return newSViv((IV)va_arg(args, void *));
411
412 case GAIM_TYPE_BOXED:
413 /* Uh.. I dunno. Try this? */
414 return sv_2mortal(gaim_perl_bless_object(
415 va_arg(args, void *),
416 gaim_value_get_specific_type(value)));
417
418 default:
419 /* If this happens, things are going to get screwed up... */
420 return NULL;
421 }
422 }

Mercurial Repository: pidgin3

mercurial