| 1 | #ifndef INC_BARNOWL_OWL_PERL_H |
|---|
| 2 | #define INC_BARNOWL_OWL_PERL_H |
|---|
| 3 | |
|---|
| 4 | #include <stdio.h> |
|---|
| 5 | |
|---|
| 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 | } |
|---|
| 22 | |
|---|
| 23 | /* |
|---|
| 24 | * This macro defines a convenience wrapper around the boilerplate of |
|---|
| 25 | * the perlcall methods. |
|---|
| 26 | * |
|---|
| 27 | * Arguments are |
|---|
| 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 |
|---|
| 35 | * |
|---|
| 36 | * See also: `perldoc perlcall', `perldoc perlapi' |
|---|
| 37 | */ |
|---|
| 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); \ |
|---|
| 65 | } \ |
|---|
| 66 | } else if (!discardret) { \ |
|---|
| 67 | ret; \ |
|---|
| 68 | } \ |
|---|
| 69 | PUTBACK; \ |
|---|
| 70 | FREETMPS; \ |
|---|
| 71 | LEAVE; \ |
|---|
| 72 | } |
|---|
| 73 | |
|---|
| 74 | #endif /* INC_BARNOWL_OWL_PERL_H */ |
|---|