Changeset 0c71c58


Ignore:
Timestamp:
Sep 30, 2011, 8:22:50 AM (14 years ago)
Author:
Jason Gross <jgross@mit.edu>
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)
Message:
Refactor perl calls through a single method

I don't know the perl/C interface well enough to figure out the best way
to standardize the many variants that we use to call perl code.  Perhaps
we should standardize the error messages, and put less knobs on the
boilerplate macro.
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • owl_perl.h

    rf271129 r0c71c58  
    44#include <stdio.h>
    55
    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}
    722
    823/*
    924 * 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.
    1126 *
    1227 * 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
    1935 *
    2036 * See also: `perldoc perlcall', `perldoc perlapi'
    2137 */
    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); \
    3965    } \
    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; \
    5572}
    5673

  • perlconfig.c

    r7803326 r0c71c58  
    224224CALLER_OWN char *owl_perlconfig_call_with_message(const char *subname, const owl_message *m)
    225225{
    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
    235229  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                );
    266245  return out;
    267246}
    … …  
    273252CALLER_OWN char *owl_perlconfig_message_call_method(const owl_message *m, const char *method, int argc, const char **argv)
    274253{
    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;
    279257
    280258  msgref = owl_perlconfig_message2hashref(m);
    281259
    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                );
    319275  return out;
    320276}
    … …  
    455411void owl_perlconfig_new_command(const char *name)
    456412{
    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                );
    476424}
    477425
    … …  
    479427CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv)
    480428{
    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;
    515448}
    516449
    … …  
    523456{
    524457  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) {
    529461    owl_function_error("Perl callback is NULL!");
    530462    return;
    531463  }
    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                );
    550477}
    551478

  • style.c

    r14be3a5 r0c71c58  
    2323{
    2424  SV *sv = NULL;
    25   OWL_PERL_CALL_METHOD(s->perlobj,
    26                        "description",
    27                        ;,
    28                        "Error in style_get_description: %s",
    29                        0,
    30                        sv = SvREFCNT_inc(POPs);
    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) {
    3333    return SvPV_nolen(sv_2mortal(sv));
    3434  } else {
    … …  
    5050 
    5151  /* 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                );
    5960
    60   if(sv) {
     61  if (sv) {
    6162    body = SvPV_nolen(sv);
    6263  } else {
Note: See TracChangeset for help on using the changeset viewer.