Changeset f248113
- Timestamp:
- Jun 22, 2013, 12:37:47 PM (11 years ago)
- Parents:
- 1b17f50 (diff), 96d80e9 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent. - Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
owl_perl.h
rf271129 r92ffd89 4 4 #include <stdio.h> 5 5 6 #define OWL_PERL_VOID_CALL (void)POPs; 6 /* 7 * This macro defines a convenience wrapper around the boilerplate 8 * of pushing char * arguments on to the stack for perl calling. 9 * 10 * Arguments are 11 * * i - the counter variable to use, which must be declared prior 12 * to calling this macro 13 * * argc - the number of arguments 14 * * argv - an array of char*s, of length at least argc; the arguments 15 * to push on to the stack 16 */ 17 #define OWL_PERL_PUSH_ARGS(i, argc, argv) { \ 18 for (i = 0; i < argc; i++) { \ 19 XPUSHs(sv_2mortal(owl_new_sv(argv[i]))); \ 20 } \ 21 } 7 22 8 23 /* 9 24 * This macro defines a convenience wrapper around the boilerplate of 10 * calling a method on a perl object (SV*) from C.25 * the perlcall methods. 11 26 * 12 27 * Arguments are 13 * * obj - the SV* to call the method on 14 * * meth - a char* method name 15 * * args - a code block responsible for pushing args (other than the object) 16 * * err - a string with a %s format specifier to log in case of error 17 * * fatalp - if true, perl errors terminate BarnOwl 18 * * ret - a code block executed if the call succeeded 28 * * call - the line of code to make the perl call 29 * * args - a code block responsible for pushing args 30 * * err - a string with a %s format specifier to log in case of error 31 * * fatalp - if true, perl errors terminate BarnOwl 32 * * discardret - should be true if no return is expected 33 * (if the call is passed the flag G_DISCARD or G_VOID) 34 * * ret - a code block executed if the call succeeded 19 35 * 20 36 * See also: `perldoc perlcall', `perldoc perlapi' 21 37 */ 22 #define OWL_PERL_CALL_METHOD(obj, meth, args, err, fatalp, ret) { \ 23 int count; \ 24 dSP; \ 25 ENTER; \ 26 SAVETMPS; \ 27 PUSHMARK(SP); \ 28 XPUSHs(obj); \ 29 {args} \ 30 PUTBACK; \ 31 \ 32 count = call_method(meth, G_SCALAR|G_EVAL); \ 33 \ 34 SPAGAIN; \ 35 \ 36 if(count != 1) { \ 37 fprintf(stderr, "perl returned wrong count: %d\n", count); \ 38 abort(); \ 38 #define OWL_PERL_CALL(call, args, err, fatalp, discardret, ret) { \ 39 int count; \ 40 dSP; \ 41 \ 42 ENTER; \ 43 SAVETMPS; \ 44 \ 45 PUSHMARK(SP); \ 46 {args} \ 47 PUTBACK; \ 48 \ 49 count = call; \ 50 \ 51 SPAGAIN; \ 52 \ 53 if (!discardret && count != 1) { \ 54 croak("Perl returned wrong count: %d\n", count); \ 55 } \ 56 \ 57 if (SvTRUE(ERRSV)) { \ 58 if (fatalp) { \ 59 fprintf(stderr, err, SvPV_nolen(ERRSV)); \ 60 exit(-1); \ 61 } else { \ 62 owl_function_error(err, SvPV_nolen(ERRSV)); \ 63 if (!discardret) (void)POPs; \ 64 sv_setsv(ERRSV, &PL_sv_undef); \ 39 65 } \ 40 if (SvTRUE(ERRSV)) { \ 41 if(fatalp) { \ 42 printf(err, SvPV_nolen(ERRSV)); \ 43 exit(-1); \ 44 } else { \ 45 owl_function_error(err, SvPV_nolen(ERRSV)); \ 46 (void)POPs; \ 47 sv_setsv(ERRSV, &PL_sv_undef); \ 48 } \ 49 } else { \ 50 ret; \ 51 } \ 52 PUTBACK; \ 53 FREETMPS; \ 54 LEAVE; \ 66 } else if (!discardret) { \ 67 ret; \ 68 } \ 69 PUTBACK; \ 70 FREETMPS; \ 71 LEAVE; \ 55 72 } 56 73 -
perlconfig.c
re5210c9 r96d80e9 228 228 CALLER_OWN char *owl_perlconfig_call_with_message(const char *subname, const owl_message *m) 229 229 { 230 dSP ; 231 int count; 232 SV *msgref, *srv; 233 char *out; 234 235 ENTER ; 236 SAVETMPS; 237 238 PUSHMARK(SP) ; 230 SV *msgref, *rv; 231 char *out = NULL; 232 239 233 msgref = owl_perlconfig_message2hashref(m); 240 XPUSHs(sv_2mortal(msgref)); 241 PUTBACK ; 242 243 count = call_pv(subname, G_SCALAR|G_EVAL); 244 245 SPAGAIN ; 246 247 if (SvTRUE(ERRSV)) { 248 owl_function_error("Perl Error: '%s'", SvPV_nolen(ERRSV)); 249 /* and clear the error */ 250 sv_setsv (ERRSV, &PL_sv_undef); 251 } 252 253 if (count != 1) { 254 fprintf(stderr, "bad perl! no biscuit! returned wrong count!\n"); 255 abort(); 256 } 257 258 srv = POPs; 259 260 if (srv) { 261 out = g_strdup(SvPV_nolen(srv)); 262 } else { 263 out = NULL; 264 } 265 266 PUTBACK ; 267 FREETMPS ; 268 LEAVE ; 269 234 235 OWL_PERL_CALL((call_pv(subname, G_SCALAR|G_EVAL)) 236 , 237 XPUSHs(sv_2mortal(msgref)); 238 , 239 "Perl Error: '%s'" 240 , 241 false 242 , 243 false 244 , 245 rv = POPs; 246 if (rv && SvPOK(rv)) 247 out = g_strdup(SvPV_nolen(rv)); 248 ); 270 249 return out; 271 250 } … … 277 256 CALLER_OWN char *owl_perlconfig_message_call_method(const owl_message *m, const char *method, int argc, const char **argv) 278 257 { 279 dSP; 280 unsigned int count, i; 281 SV *msgref, *srv; 282 char *out; 258 SV *msgref, *rv; 259 char *out = NULL; 260 int i; 283 261 284 262 msgref = owl_perlconfig_message2hashref(m); 285 263 286 ENTER; 287 SAVETMPS; 288 289 PUSHMARK(SP); 290 XPUSHs(sv_2mortal(msgref)); 291 for(i=0;i<argc;i++) { 292 XPUSHs(sv_2mortal(owl_new_sv(argv[i]))); 293 } 294 PUTBACK; 295 296 count = call_method(method, G_SCALAR|G_EVAL); 297 298 SPAGAIN; 299 300 if(count != 1) { 301 fprintf(stderr, "perl returned wrong count %u\n", count); 302 abort(); 303 } 304 305 if (SvTRUE(ERRSV)) { 306 owl_function_error("Error: '%s'", SvPV_nolen(ERRSV)); 307 /* and clear the error */ 308 sv_setsv (ERRSV, &PL_sv_undef); 309 } 310 311 srv = POPs; 312 313 if (srv) { 314 out = g_strdup(SvPV_nolen(srv)); 315 } else { 316 out = NULL; 317 } 318 319 PUTBACK; 320 FREETMPS; 321 LEAVE; 322 264 OWL_PERL_CALL(call_method(method, G_SCALAR|G_EVAL) 265 , 266 XPUSHs(sv_2mortal(msgref)); 267 OWL_PERL_PUSH_ARGS(i, argc, argv); 268 , 269 "Perl Error: '%s'" 270 , 271 false 272 , 273 false 274 , 275 rv = POPs; 276 if (rv && SvPOK(rv)) 277 out = g_strdup(SvPV_nolen(rv)); 278 ); 323 279 return out; 324 280 } … … 470 426 void owl_perlconfig_new_command(const char *name) 471 427 { 472 dSP; 473 474 ENTER; 475 SAVETMPS; 476 477 PUSHMARK(SP); 478 XPUSHs(sv_2mortal(owl_new_sv(name))); 479 PUTBACK; 480 481 call_pv("BarnOwl::Hooks::_new_command", G_VOID|G_EVAL); 482 483 SPAGAIN; 484 485 if(SvTRUE(ERRSV)) { 486 owl_function_error("%s", SvPV_nolen(ERRSV)); 487 } 488 489 FREETMPS; 490 LEAVE; 428 OWL_PERL_CALL(call_pv("BarnOwl::Hooks::_new_command", G_VOID|G_EVAL); 429 , 430 XPUSHs(sv_2mortal(owl_new_sv(name))); 431 , 432 "Perl Error: '%s'" 433 , 434 false 435 , 436 true 437 , 438 ); 439 } 440 441 CALLER_OWN char *owl_perlconfig_perl_call(const char *method, int argc, const char *const *argv) 442 { 443 SV *rv; 444 char *out = NULL; 445 int i; 446 OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL) 447 , 448 OWL_PERL_PUSH_ARGS(i, argc, argv); 449 , 450 "Perl Error: '%s'" 451 , 452 false 453 , 454 false 455 , 456 rv = POPs; 457 if (rv && SvPOK(rv)) 458 out = g_strdup(SvPV_nolen(rv)); 459 ); 460 return out; 461 } 462 463 int owl_perlconfig_perl_call_int(const char *method, int argc, const char *const *argv) 464 { 465 SV *rv; 466 int ret = -1; 467 int i; 468 OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL) 469 , 470 OWL_PERL_PUSH_ARGS(i, argc, argv); 471 , 472 "Perl Error: '%s'" 473 , 474 false 475 , 476 false 477 , 478 rv = POPs; 479 if (rv && SvIOK(rv)) 480 ret = SvIV(rv); 481 ); 482 return ret; 483 } 484 485 bool owl_perlconfig_perl_call_bool(const char *method, int argc, const char *const *argv) 486 { 487 SV *rv; 488 bool ret = false; 489 int i; 490 OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL) 491 , 492 OWL_PERL_PUSH_ARGS(i, argc, argv); 493 , 494 "Perl Error: '%s'" 495 , 496 false 497 , 498 false 499 , 500 rv = POPs; 501 if (rv) 502 ret = SvTRUE(rv); 503 ); 504 return ret; 505 } 506 507 void owl_perlconfig_perl_call_norv(const char *method, int argc, const char *const *argv) 508 { 509 int i; 510 OWL_PERL_CALL(call_pv(method, G_DISCARD|G_EVAL) 511 , 512 OWL_PERL_PUSH_ARGS(i, argc, argv); 513 , 514 "Perl Error: '%s'" 515 , 516 false 517 , 518 true 519 , 520 ); 491 521 } 492 522 … … 494 524 CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv) 495 525 { 496 int i, count; 497 char * ret = NULL; 498 SV *rv; 499 dSP; 500 501 ENTER; 502 SAVETMPS; 503 504 PUSHMARK(SP); 505 for(i=0;i<argc;i++) { 506 XPUSHs(sv_2mortal(owl_new_sv(argv[i]))); 507 } 508 PUTBACK; 509 510 count = call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL); 511 512 SPAGAIN; 513 514 if(SvTRUE(ERRSV)) { 515 owl_function_error("%s", SvPV_nolen(ERRSV)); 516 (void)POPs; 517 } else { 518 if(count != 1) 519 croak("Perl command %s returned more than one value!", cmd->name); 520 rv = POPs; 521 if(SvTRUE(rv)) { 522 ret = g_strdup(SvPV_nolen(rv)); 523 } 524 } 525 526 FREETMPS; 527 LEAVE; 528 529 return ret; 526 int i; 527 SV* rv; 528 char *out = NULL; 529 530 OWL_PERL_CALL(call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL) 531 , 532 OWL_PERL_PUSH_ARGS(i, argc, argv); 533 , 534 "Perl Error: '%s'" 535 , 536 false 537 , 538 false 539 , 540 rv = POPs; 541 if (rv && SvPOK(rv)) 542 out = g_strdup(SvPV_nolen(rv)); 543 ); 544 return out; 530 545 } 531 546 … … 538 553 { 539 554 SV *cb = owl_editwin_get_cbdata(e); 540 SV *text; 541 dSP; 542 543 if(cb == NULL) { 555 SV *text = owl_new_sv(owl_editwin_get_text(e)); 556 557 if (cb == NULL) { 544 558 owl_function_error("Perl callback is NULL!"); 545 559 return; 546 560 } 547 text = owl_new_sv(owl_editwin_get_text(e)); 548 549 ENTER; 550 SAVETMPS; 551 552 PUSHMARK(SP); 553 XPUSHs(sv_2mortal(text)); 554 XPUSHs(sv_2mortal(newSViv(success))); 555 PUTBACK; 556 557 call_sv(cb, G_DISCARD|G_EVAL); 558 559 if(SvTRUE(ERRSV)) { 560 owl_function_error("%s", SvPV_nolen(ERRSV)); 561 } 562 563 FREETMPS; 564 LEAVE; 561 562 OWL_PERL_CALL(call_sv(cb, G_DISCARD|G_EVAL) 563 , 564 XPUSHs(sv_2mortal(text)); 565 XPUSHs(sv_2mortal(newSViv(success))); 566 , 567 "Perl Error: '%s'" 568 , 569 false 570 , 571 true 572 , 573 ); 565 574 } 566 575 -
style.c
r14be3a5 r92ffd89 23 23 { 24 24 SV *sv = NULL; 25 OWL_PERL_CALL _METHOD(s->perlobj,26 "description",27 ;,28 "Error in style_get_description: %s",29 0,30 31 32 if (sv) {25 OWL_PERL_CALL(call_method("description", G_SCALAR|G_EVAL), 26 XPUSHs(s->perlobj);, 27 "Error in style_get_description: %s", 28 0, 29 false, 30 sv = SvREFCNT_inc(POPs); 31 ); 32 if (sv) { 33 33 return SvPV_nolen(sv_2mortal(sv)); 34 34 } else { … … 50 50 51 51 /* Call the perl object */ 52 OWL_PERL_CALL_METHOD(s->perlobj, 53 "format_message", 54 XPUSHs(sv_2mortal(owl_perlconfig_message2hashref(m)));, 55 "Error in format_message: %s", 56 0, 57 sv = SvREFCNT_inc(POPs); 58 ); 52 OWL_PERL_CALL(call_method("format_message", G_SCALAR|G_EVAL), 53 XPUSHs(s->perlobj); 54 XPUSHs(sv_2mortal(owl_perlconfig_message2hashref(m)));, 55 "Error in format_message: %s", 56 0, 57 false, 58 sv = SvREFCNT_inc(POPs); 59 ); 59 60 60 if (sv) {61 if (sv) { 61 62 body = SvPV_nolen(sv); 62 63 } else {
Note: See TracChangeset
for help on using the changeset viewer.