Changeset 0c71c58
- Timestamp:
- Sep 30, 2011, 8:22:50 AM (12 years ago)
- Children:
- 57ad328
- Parents:
- 7803326
- git-author:
- Jason Gross <jgross@mit.edu> (09/21/11 14:45:34)
- git-committer:
- Jason Gross <jgross@mit.edu> (09/30/11 08:22:50)
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
owl_perl.h
rf271129 r0c71c58 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
r7803326 r0c71c58 224 224 CALLER_OWN char *owl_perlconfig_call_with_message(const char *subname, const owl_message *m) 225 225 { 226 dSP ; 227 int count; 228 SV *msgref, *srv; 229 char *out; 230 231 ENTER ; 232 SAVETMPS; 233 234 PUSHMARK(SP) ; 226 SV *msgref, *rv; 227 char *out = NULL; 228 235 229 msgref = owl_perlconfig_message2hashref(m); 236 XPUSHs(sv_2mortal(msgref)); 237 PUTBACK ; 238 239 count = call_pv(subname, G_SCALAR|G_EVAL); 240 241 SPAGAIN ; 242 243 if (SvTRUE(ERRSV)) { 244 owl_function_error("Perl Error: '%s'", SvPV_nolen(ERRSV)); 245 /* and clear the error */ 246 sv_setsv (ERRSV, &PL_sv_undef); 247 } 248 249 if (count != 1) { 250 fprintf(stderr, "bad perl! no biscuit! returned wrong count!\n"); 251 abort(); 252 } 253 254 srv = POPs; 255 256 if (srv) { 257 out = g_strdup(SvPV_nolen(srv)); 258 } else { 259 out = NULL; 260 } 261 262 PUTBACK ; 263 FREETMPS ; 264 LEAVE ; 265 230 231 OWL_PERL_CALL((call_pv(subname, G_SCALAR|G_EVAL)) 232 , 233 XPUSHs(sv_2mortal(msgref)); 234 , 235 "Perl Error: '%s'" 236 , 237 false 238 , 239 false 240 , 241 rv = POPs; 242 if (rv && SvPOK(rv)) 243 out = g_strdup(SvPV_nolen(rv)); 244 ); 266 245 return out; 267 246 } … … 273 252 CALLER_OWN char *owl_perlconfig_message_call_method(const owl_message *m, const char *method, int argc, const char **argv) 274 253 { 275 dSP; 276 unsigned int count, i; 277 SV *msgref, *srv; 278 char *out; 254 SV *msgref, *rv; 255 char *out = NULL; 256 int i; 279 257 280 258 msgref = owl_perlconfig_message2hashref(m); 281 259 282 ENTER; 283 SAVETMPS; 284 285 PUSHMARK(SP); 286 XPUSHs(sv_2mortal(msgref)); 287 for(i=0;i<argc;i++) { 288 XPUSHs(sv_2mortal(owl_new_sv(argv[i]))); 289 } 290 PUTBACK; 291 292 count = call_method(method, G_SCALAR|G_EVAL); 293 294 SPAGAIN; 295 296 if(count != 1) { 297 fprintf(stderr, "perl returned wrong count %u\n", count); 298 abort(); 299 } 300 301 if (SvTRUE(ERRSV)) { 302 owl_function_error("Error: '%s'", SvPV_nolen(ERRSV)); 303 /* and clear the error */ 304 sv_setsv (ERRSV, &PL_sv_undef); 305 } 306 307 srv = POPs; 308 309 if (srv) { 310 out = g_strdup(SvPV_nolen(srv)); 311 } else { 312 out = NULL; 313 } 314 315 PUTBACK; 316 FREETMPS; 317 LEAVE; 318 260 OWL_PERL_CALL(call_method(method, G_SCALAR|G_EVAL) 261 , 262 XPUSHs(sv_2mortal(msgref)); 263 OWL_PERL_PUSH_ARGS(i, argc, argv); 264 , 265 "Perl Error: '%s'" 266 , 267 false 268 , 269 false 270 , 271 rv = POPs; 272 if (rv && SvPOK(rv)) 273 out = g_strdup(SvPV_nolen(rv)); 274 ); 319 275 return out; 320 276 } … … 455 411 void owl_perlconfig_new_command(const char *name) 456 412 { 457 dSP; 458 459 ENTER; 460 SAVETMPS; 461 462 PUSHMARK(SP); 463 XPUSHs(sv_2mortal(owl_new_sv(name))); 464 PUTBACK; 465 466 call_pv("BarnOwl::Hooks::_new_command", G_VOID|G_EVAL); 467 468 SPAGAIN; 469 470 if(SvTRUE(ERRSV)) { 471 owl_function_error("%s", SvPV_nolen(ERRSV)); 472 } 473 474 FREETMPS; 475 LEAVE; 413 OWL_PERL_CALL(call_pv("BarnOwl::Hooks::_new_command", G_VOID|G_EVAL); 414 , 415 XPUSHs(sv_2mortal(owl_new_sv(name))); 416 , 417 "Perl Error: '%s'" 418 , 419 false 420 , 421 true 422 , 423 ); 476 424 } 477 425 … … 479 427 CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv) 480 428 { 481 int i, count; 482 char * ret = NULL; 483 SV *rv; 484 dSP; 485 486 ENTER; 487 SAVETMPS; 488 489 PUSHMARK(SP); 490 for(i=0;i<argc;i++) { 491 XPUSHs(sv_2mortal(owl_new_sv(argv[i]))); 492 } 493 PUTBACK; 494 495 count = call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL); 496 497 SPAGAIN; 498 499 if(SvTRUE(ERRSV)) { 500 owl_function_error("%s", SvPV_nolen(ERRSV)); 501 (void)POPs; 502 } else { 503 if(count != 1) 504 croak("Perl command %s returned more than one value!", cmd->name); 505 rv = POPs; 506 if(SvTRUE(rv)) { 507 ret = g_strdup(SvPV_nolen(rv)); 508 } 509 } 510 511 FREETMPS; 512 LEAVE; 513 514 return ret; 429 int i; 430 SV* rv; 431 char *out = NULL; 432 433 OWL_PERL_CALL(call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL) 434 , 435 OWL_PERL_PUSH_ARGS(i, argc, argv); 436 , 437 "Perl Error: '%s'" 438 , 439 false 440 , 441 false 442 , 443 rv = POPs; 444 if (rv && SvPOK(rv)) 445 out = g_strdup(SvPV_nolen(rv)); 446 ); 447 return out; 515 448 } 516 449 … … 523 456 { 524 457 SV *cb = owl_editwin_get_cbdata(e); 525 SV *text; 526 dSP; 527 528 if(cb == NULL) { 458 SV *text = owl_new_sv(owl_editwin_get_text(e)); 459 460 if (cb == NULL) { 529 461 owl_function_error("Perl callback is NULL!"); 530 462 return; 531 463 } 532 text = owl_new_sv(owl_editwin_get_text(e)); 533 534 ENTER; 535 SAVETMPS; 536 537 PUSHMARK(SP); 538 XPUSHs(sv_2mortal(text)); 539 XPUSHs(sv_2mortal(newSViv(success))); 540 PUTBACK; 541 542 call_sv(cb, G_DISCARD|G_EVAL); 543 544 if(SvTRUE(ERRSV)) { 545 owl_function_error("%s", SvPV_nolen(ERRSV)); 546 } 547 548 FREETMPS; 549 LEAVE; 464 465 OWL_PERL_CALL(call_sv(cb, G_DISCARD|G_EVAL) 466 , 467 XPUSHs(sv_2mortal(text)); 468 XPUSHs(sv_2mortal(newSViv(success))); 469 , 470 "Perl Error: '%s'" 471 , 472 false 473 , 474 true 475 , 476 ); 550 477 } 551 478 -
style.c
r14be3a5 r0c71c58 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.