comparison plugins/perl/perl-common.c @ 6920:13f78c350cd3

[gaim-migrate @ 7467] Fixed problems with the wrong data being sent to signal callbacks in perl plugins. The resulting code has more sanity checks, but is extremely ugly, and is therefore rated R. Parents, don't let your children see perl-common.c. committer: Tailor Script <tailor@pidgin.im>
author Christian Hammond <chipx86@chipx86.com>
date Wed, 24 Sep 2003 00:03:08 +0000
parents 806f6e950e76
children 11d05ddf30a3
comparison
equal deleted inserted replaced
6919:1aa771990188 6920:13f78c350cd3
354 354
355 return TRUE; 355 return TRUE;
356 } 356 }
357 #endif 357 #endif
358 358
359 void *
360 gaim_perl_data_from_sv(GaimValue *value, SV *sv)
361 {
362 STRLEN na;
363
364 switch (gaim_value_get_type(value))
365 {
366 case GAIM_TYPE_BOOLEAN: return (void *)SvIV(sv);
367 case GAIM_TYPE_INT: return (void *)SvIV(sv);
368 case GAIM_TYPE_UINT: return (void *)SvUV(sv);
369 case GAIM_TYPE_LONG: return (void *)SvIV(sv);
370 case GAIM_TYPE_ULONG: return (void *)SvUV(sv);
371 case GAIM_TYPE_INT64: return (void *)SvIV(sv);
372 case GAIM_TYPE_UINT64: return (void *)SvUV(sv);
373 case GAIM_TYPE_STRING: return (void *)SvPV(sv, na);
374 case GAIM_TYPE_POINTER: return (void *)SvIV(sv);
375 case GAIM_TYPE_BOXED: return (void *)SvIV(sv);
376
377 default:
378 return NULL;
379 }
380
381 return NULL;
382 }
383
359 static SV * 384 static SV *
360 gaim_perl_sv_from_subtype(const GaimValue *value, void *arg) 385 gaim_perl_sv_from_subtype(const GaimValue *value, void *arg)
361 { 386 {
362 const char *stash = NULL; 387 const char *stash = NULL;
363 388
379 404
380 return sv_2mortal(gaim_perl_bless_object(arg, stash)); 405 return sv_2mortal(gaim_perl_bless_object(arg, stash));
381 } 406 }
382 407
383 SV * 408 SV *
384 gaim_perl_sv_from_vargs(const GaimValue *value, va_list args) 409 gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args,
410 void **copy_arg)
385 { 411 {
386 if (gaim_value_is_outgoing(value)) 412 if (gaim_value_is_outgoing(value))
387 { 413 {
388 switch (gaim_value_get_type(value)) 414 switch (gaim_value_get_type(value))
389 { 415 {
390 case GAIM_TYPE_SUBTYPE: 416 case GAIM_TYPE_SUBTYPE:
391 return gaim_perl_sv_from_subtype(value, *va_arg(args, void **)); 417 if ((*copy_arg = va_arg(*args, void **)) == NULL)
418 return &PL_sv_undef;
419
420 return gaim_perl_sv_from_subtype(value, *(void **)*copy_arg);
392 421
393 case GAIM_TYPE_BOOLEAN: 422 case GAIM_TYPE_BOOLEAN:
394 return newSViv(*va_arg(args, gboolean *)); 423 if ((*copy_arg = va_arg(*args, gboolean *)) == NULL)
424 return &PL_sv_undef;
425
426 return newSViv(*(gboolean *)*copy_arg);
395 427
396 case GAIM_TYPE_INT: 428 case GAIM_TYPE_INT:
397 return newSViv(*va_arg(args, int *)); 429 if ((*copy_arg = va_arg(*args, int *)) == NULL)
430 return &PL_sv_undef;
431
432 return newSViv(*(int *)*copy_arg);
398 433
399 case GAIM_TYPE_UINT: 434 case GAIM_TYPE_UINT:
400 return newSVuv(*va_arg(args, unsigned int *)); 435 if ((*copy_arg = va_arg(*args, unsigned int *)) == NULL)
436 return &PL_sv_undef;
437
438 return newSVuv(*(unsigned int *)*copy_arg);
401 439
402 case GAIM_TYPE_LONG: 440 case GAIM_TYPE_LONG:
403 return newSViv(*va_arg(args, long *)); 441 if ((*copy_arg = va_arg(*args, long *)) == NULL)
442 return &PL_sv_undef;
443
444 return newSViv(*(long *)*copy_arg);
404 445
405 case GAIM_TYPE_ULONG: 446 case GAIM_TYPE_ULONG:
406 return newSVuv(*va_arg(args, unsigned long *)); 447 if ((*copy_arg = va_arg(*args, unsigned long *)) == NULL)
448 return &PL_sv_undef;
449
450 return newSVuv(*(unsigned long *)*copy_arg);
407 451
408 case GAIM_TYPE_INT64: 452 case GAIM_TYPE_INT64:
409 return newSViv(*va_arg(args, gint64 *)); 453 if ((*copy_arg = va_arg(*args, gint64 *)) == NULL)
454 return &PL_sv_undef;
455
456 return newSViv(*(gint64 *)*copy_arg);
410 457
411 case GAIM_TYPE_UINT64: 458 case GAIM_TYPE_UINT64:
412 return newSVuv(*va_arg(args, guint64 *)); 459 if ((*copy_arg = va_arg(*args, guint64 *)) == NULL)
460 return &PL_sv_undef;
461
462 return newSVuv(*(guint64 *)*copy_arg);
413 463
414 case GAIM_TYPE_STRING: 464 case GAIM_TYPE_STRING:
415 return newSVGChar(*va_arg(args, char **)); 465 if ((*copy_arg = va_arg(*args, char **)) == NULL)
466 return &PL_sv_undef;
467
468 return newSVGChar(*(char **)*copy_arg);
416 469
417 case GAIM_TYPE_POINTER: 470 case GAIM_TYPE_POINTER:
418 return newSViv((IV)*va_arg(args, void **)); 471 if ((*copy_arg = va_arg(*args, void **)) == NULL)
472 return &PL_sv_undef;
473
474 return newSViv((IV)*(void **)*copy_arg);
419 475
420 case GAIM_TYPE_BOXED: 476 case GAIM_TYPE_BOXED:
421 /* Uh.. I dunno. Try this? */ 477 /* Uh.. I dunno. Try this? */
478 if ((*copy_arg = va_arg(*args, void **)) == NULL)
479 return &PL_sv_undef;
480
422 return sv_2mortal(gaim_perl_bless_object( 481 return sv_2mortal(gaim_perl_bless_object(
423 va_arg(args, void **), 482 *(void **)*copy_arg,
424 gaim_value_get_specific_type(value))); 483 gaim_value_get_specific_type(value)));
425 484
426 default: 485 default:
427 /* If this happens, things are going to get screwed up... */ 486 /* If this happens, things are going to get screwed up... */
428 return NULL; 487 return NULL;
431 else 490 else
432 { 491 {
433 switch (gaim_value_get_type(value)) 492 switch (gaim_value_get_type(value))
434 { 493 {
435 case GAIM_TYPE_SUBTYPE: 494 case GAIM_TYPE_SUBTYPE:
436 return gaim_perl_sv_from_subtype(value, va_arg(args, void *)); 495 if ((*copy_arg = va_arg(*args, void *)) == NULL)
496 return &PL_sv_undef;
497
498 return gaim_perl_sv_from_subtype(value, *copy_arg);
437 499
438 case GAIM_TYPE_BOOLEAN: 500 case GAIM_TYPE_BOOLEAN:
439 return newSViv(va_arg(args, gboolean)); 501 *copy_arg = (void *)va_arg(*args, gboolean);
502
503 return newSViv((gboolean)*copy_arg);
440 504
441 case GAIM_TYPE_INT: 505 case GAIM_TYPE_INT:
442 return newSViv(va_arg(args, int)); 506 *copy_arg = (void *)va_arg(*args, int);
507
508 return newSViv((int)*copy_arg);
443 509
444 case GAIM_TYPE_UINT: 510 case GAIM_TYPE_UINT:
445 return newSVuv(va_arg(args, unsigned int)); 511 *copy_arg = (void *)va_arg(*args, unsigned int);
512
513 return newSVuv((unsigned int)*copy_arg);
446 514
447 case GAIM_TYPE_LONG: 515 case GAIM_TYPE_LONG:
448 return newSViv(va_arg(args, long)); 516 *copy_arg = (void *)va_arg(*args, long);
517
518 return newSViv((long)*copy_arg);
449 519
450 case GAIM_TYPE_ULONG: 520 case GAIM_TYPE_ULONG:
451 return newSVuv(va_arg(args, unsigned long)); 521 *copy_arg = (void *)va_arg(*args, unsigned long);
522
523 return newSVuv((unsigned long)*copy_arg);
452 524
453 case GAIM_TYPE_INT64: 525 case GAIM_TYPE_INT64:
454 return newSViv(va_arg(args, gint64)); 526 #if 0
527 /* XXX This yells and complains. */
528 *copy_arg = va_arg(*args, gint64);
529
530 return newSViv(*copy_arg);
531 #endif
532 break;
455 533
456 case GAIM_TYPE_UINT64: 534 case GAIM_TYPE_UINT64:
457 return newSVuv(va_arg(args, guint64)); 535 /* XXX This also yells and complains. */
536 #if 0
537 *copy_arg = (void *)va_arg(*args, guint64);
538
539 return newSVuv(*copy_arg);
540 #endif
541 break;
458 542
459 case GAIM_TYPE_STRING: 543 case GAIM_TYPE_STRING:
460 return newSVGChar(va_arg(args, char *)); 544 if ((*copy_arg = (void *)va_arg(*args, char *)) == NULL)
545 return &PL_sv_undef;
546
547 return newSVGChar(*copy_arg);
461 548
462 case GAIM_TYPE_POINTER: 549 case GAIM_TYPE_POINTER:
463 return newSViv((IV)va_arg(args, void *)); 550 if ((*copy_arg = (void *)va_arg(*args, void *)) == NULL)
551 return &PL_sv_undef;
552
553 return newSViv((IV)*copy_arg);
464 554
465 case GAIM_TYPE_BOXED: 555 case GAIM_TYPE_BOXED:
466 /* Uh.. I dunno. Try this? */ 556 /* Uh.. I dunno. Try this? */
467 return sv_2mortal(gaim_perl_bless_object( 557 if ((*copy_arg = (void *)va_arg(*args, void *)) == NULL)
468 va_arg(args, void *), 558 return &PL_sv_undef;
559
560 return sv_2mortal(gaim_perl_bless_object(*copy_arg,
469 gaim_value_get_specific_type(value))); 561 gaim_value_get_specific_type(value)));
470 562
471 default: 563 default:
472 /* If this happens, things are going to get screwed up... */ 564 /* If this happens, things are going to get screwed up... */
473 return NULL; 565 return NULL;
474 } 566 }
475 } 567 }
476 } 568
569 return NULL;
570 }