Mercurial > pidgin3 / file comparison

comparison: plugins/perl/perl-common.c

plugins/perl/perl-common.c

changeset 12871
3584d93ae63c
parent 12837
91261adc87b3
child 12891
6e089bd3cb0e
equal deleted inserted replaced
12870:20dd598144a9 12871:3584d93ae63c
7 7
8 static GHashTable *object_stashes = NULL; 8 static GHashTable *object_stashes = NULL;
9 9
10 void gaim_perl_normalize_script_name(char *name) 10 void gaim_perl_normalize_script_name(char *name)
11 { 11 {
12 char *c; 12 char *c;
13 13
14 c = strrchr(name, '.'); 14 c = strrchr(name, '.');
15 15
16 if (c != NULL) 16 if (c != NULL)
17 *c = '\0'; 17 *c = '\0';
18 18
19 for (c = name; *c != '\0'; c++) 19 for (c = name; *c != '\0'; c++) {
20 { 20 if (*c != '_' && !g_ascii_isalnum(*c))
21 if (*c != '_' && !g_ascii_isalnum(*c)) 21 *c = '_';
22 *c = '_'; 22 }
23 } 23 }
24 }
25
26 24
27 static int 25 static int
28 magic_free_object(pTHX_ SV *sv, MAGIC *mg) 26 magic_free_object(pTHX_ SV *sv, MAGIC *mg)
29 { 27 {
30 sv_setiv(sv, 0); 28 sv_setiv(sv, 0);
73 HV *hv; 71 HV *hv;
74 72
75 if (object == NULL) 73 if (object == NULL)
76 return NULL; 74 return NULL;
77 75
78 if (object_stashes == NULL) 76 if (object_stashes == NULL) {
79 {
80 object_stashes = g_hash_table_new(g_direct_hash, g_direct_equal); 77 object_stashes = g_hash_table_new(g_direct_hash, g_direct_equal);
81 } 78 }
82 79
83 stash = gv_stashpv(stash_name, 1); 80 stash = gv_stashpv(stash_name, 1);
84 81
94 SV **sv; 91 SV **sv;
95 HV *hv; 92 HV *hv;
96 93
97 hv = hvref(o); 94 hv = hvref(o);
98 95
99 if (hv != NULL) 96 if (hv != NULL) {
100 {
101 sv = hv_fetch(hv, "_gaim", 5, 0); 97 sv = hv_fetch(hv, "_gaim", 5, 0);
102 98
103 if (sv != NULL) 99 if (sv != NULL)
104 return TRUE; 100 return TRUE;
105 } 101 }
195 XPUSHs(sv_args[i]); 191 XPUSHs(sv_args[i]);
196 } 192 }
197 } 193 }
198 194
199 PUTBACK; 195 PUTBACK;
200 PERL_SET_CONTEXT(my_perl); 196 PERL_SET_CONTEXT(my_perl);
201 count = call_pv(function, G_EVAL | G_SCALAR); 197 count = call_pv(function, G_EVAL | G_SCALAR);
202 SPAGAIN; 198 SPAGAIN;
203 199
204 /* 200 /*
205 * Check for "die," make sure we have 1 argument, and set our 201 * Check for "die," make sure we have 1 argument, and set our
208 if (SvTRUE(ERRSV)) { 204 if (SvTRUE(ERRSV)) {
209 gaim_debug(GAIM_DEBUG_ERROR, "perl", 205 gaim_debug(GAIM_DEBUG_ERROR, "perl",
210 "Perl function %s exited abnormally: %s\n", 206 "Perl function %s exited abnormally: %s\n",
211 function, SvPV(ERRSV, na)); 207 function, SvPV(ERRSV, na));
212 POPs; 208 POPs;
213 } 209 } else if (count != 1) {
214 else if (count != 1) {
215 /* 210 /*
216 * This should NEVER happen. G_SCALAR ensures that we WILL 211 * This should NEVER happen. G_SCALAR ensures that we WILL
217 * have 1 parameter. 212 * have 1 parameter.
218 */ 213 */
219 gaim_debug(GAIM_DEBUG_ERROR, "perl", 214 gaim_debug(GAIM_DEBUG_ERROR, "perl",
220 "Perl error from %s: expected 1 return value, " 215 "Perl error from %s: expected 1 return value, "
221 "but got %d\n", function, count); 216 "but got %d\n", function, count);
222 } 217 } else
223 else
224 ret_value = POPi; 218 ret_value = POPi;
225 219
226 /* Check for changed arguments */ 220 /* Check for changed arguments */
227 for (i = 0; i < argc; i++) { 221 for (i = 0; i < argc; i++) {
228 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) { 222 if (args[i] && strcmp(args[i], SvPVX(sv_args[i]))) {
384 void * 378 void *
385 gaim_perl_data_from_sv(GaimValue *value, SV *sv) 379 gaim_perl_data_from_sv(GaimValue *value, SV *sv)
386 { 380 {
387 STRLEN na; 381 STRLEN na;
388 382
389 switch (gaim_value_get_type(value)) 383 switch (gaim_value_get_type(value)) {
390 {
391 case GAIM_TYPE_BOOLEAN: return (void *)SvIV(sv); 384 case GAIM_TYPE_BOOLEAN: return (void *)SvIV(sv);
392 case GAIM_TYPE_INT: return (void *)SvIV(sv); 385 case GAIM_TYPE_INT: return (void *)SvIV(sv);
393 case GAIM_TYPE_UINT: return (void *)SvUV(sv); 386 case GAIM_TYPE_UINT: return (void *)SvUV(sv);
394 case GAIM_TYPE_LONG: return (void *)SvIV(sv); 387 case GAIM_TYPE_LONG: return (void *)SvIV(sv);
395 case GAIM_TYPE_ULONG: return (void *)SvUV(sv); 388 case GAIM_TYPE_ULONG: return (void *)SvUV(sv);
409 static SV * 402 static SV *
410 gaim_perl_sv_from_subtype(const GaimValue *value, void *arg) 403 gaim_perl_sv_from_subtype(const GaimValue *value, void *arg)
411 { 404 {
412 const char *stash = NULL; 405 const char *stash = NULL;
413 406
414 switch (gaim_value_get_subtype(value)) 407 switch (gaim_value_get_subtype(value)) {
415 { 408 case GAIM_SUBTYPE_ACCOUNT:
416 case GAIM_SUBTYPE_ACCOUNT: stash = "Gaim::Account"; break; 409 stash = "Gaim::Account";
417 case GAIM_SUBTYPE_BLIST: stash = "Gaim::BuddyList"; break; 410 break;
418 case GAIM_SUBTYPE_BLIST_BUDDY: stash = "Gaim::BuddyList::Buddy"; break; 411 case GAIM_SUBTYPE_BLIST:
419 case GAIM_SUBTYPE_BLIST_GROUP: stash = "Gaim::BuddyList::Group"; break; 412 stash = "Gaim::BuddyList";
420 case GAIM_SUBTYPE_BLIST_CHAT: stash = "Gaim::BuddyList::Chat"; break; 413 break;
421 case GAIM_SUBTYPE_CONNECTION: stash = "Gaim::Connection"; break; 414 case GAIM_SUBTYPE_BLIST_BUDDY:
422 case GAIM_SUBTYPE_CONVERSATION: stash = "Gaim::Conversation"; break; 415 stash = "Gaim::BuddyList::Buddy";
423 case GAIM_SUBTYPE_PLUGIN: stash = "Gaim::Plugin"; break; 416 break;
417 case GAIM_SUBTYPE_BLIST_GROUP:
418 stash = "Gaim::BuddyList::Group";
419 break;
420 case GAIM_SUBTYPE_BLIST_CHAT:
421 stash = "Gaim::BuddyList::Chat";
422 break;
423 case GAIM_SUBTYPE_CONNECTION:
424 stash = "Gaim::Connection";
425 break;
426 case GAIM_SUBTYPE_CONVERSATION:
427 stash = "Gaim::Conversation";
428 break;
429 case GAIM_SUBTYPE_PLUGIN:
430 stash = "Gaim::Plugin";
431 break;
424 432
425 default: 433 default:
426 stash = "Gaim"; /* ? */ 434 stash = "Gaim"; /* ? */
427 } 435 }
428 436
429 return sv_2mortal(gaim_perl_bless_object(arg, stash)); 437 return sv_2mortal(gaim_perl_bless_object(arg, stash));
430 } 438 }
431 439
432 SV * 440 SV *
433 gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args, 441 gaim_perl_sv_from_vargs(const GaimValue *value, va_list *args, void ***copy_arg)
434 void ***copy_arg) 442 {
435 { 443 if (gaim_value_is_outgoing(value)) {
436 if (gaim_value_is_outgoing(value)) 444 switch (gaim_value_get_type(value)) {
437 {
438 switch (gaim_value_get_type(value))
439 {
440 case GAIM_TYPE_SUBTYPE: 445 case GAIM_TYPE_SUBTYPE:
441 if ((*copy_arg = va_arg(*args, void **)) == NULL) 446 if ((*copy_arg = va_arg(*args, void **)) == NULL)
442 return &PL_sv_undef; 447 return &PL_sv_undef;
443 448
444 return gaim_perl_sv_from_subtype(value, *(void **)*copy_arg); 449 return gaim_perl_sv_from_subtype(value, *(void **)*copy_arg);
509 514
510 default: 515 default:
511 /* If this happens, things are going to get screwed up... */ 516 /* If this happens, things are going to get screwed up... */
512 return NULL; 517 return NULL;
513 } 518 }
514 } 519 } else {
515 else 520 switch (gaim_value_get_type(value)) {
516 {
517 switch (gaim_value_get_type(value))
518 {
519 case GAIM_TYPE_SUBTYPE: 521 case GAIM_TYPE_SUBTYPE:
520 if ((*copy_arg = va_arg(*args, void *)) == NULL) 522 if ((*copy_arg = va_arg(*args, void *)) == NULL)
521 return &PL_sv_undef; 523 return &PL_sv_undef;
522 524
523 return gaim_perl_sv_from_subtype(value, *copy_arg); 525 return gaim_perl_sv_from_subtype(value, *copy_arg);

Mercurial Repository: pidgin3

mercurial