Changeset 92ffd89


Ignore:
Timestamp:
Jun 22, 2013, 12:36:16 PM (4 years ago)
Author:
Jason Gross <jgross@mit.edu>
Branches:
master
Children:
96d80e9
Parents:
1b17f50
git-author:
Jason Gross <jgross@mit.edu> (09/21/11 14:45:34)
git-committer:
Jason Gross <jgross@mit.edu> (06/22/13 12:36:16)
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 r92ffd89  
    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

    re5210c9 r92ffd89  
    228228CALLER_OWN char *owl_perlconfig_call_with_message(const char *subname, const owl_message *m)
    229229{
    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
    239233  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                );
    270249  return out;
    271250}
     
    277256CALLER_OWN char *owl_perlconfig_message_call_method(const owl_message *m, const char *method, int argc, const char **argv)
    278257{
    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;
    283261
    284262  msgref = owl_perlconfig_message2hashref(m);
    285263
    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                );
    323279  return out;
    324280}
     
    470426void owl_perlconfig_new_command(const char *name)
    471427{
    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                );
    491439}
    492440
     
    494442CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv)
    495443{
    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;
     444  int i;
     445  SV* rv;
     446  char *out = NULL;
     447
     448  OWL_PERL_CALL(call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL)
     449                ,
     450                OWL_PERL_PUSH_ARGS(i, argc, argv);
     451                ,
     452                "Perl Error: '%s'"
     453                ,
     454                false
     455                ,
     456                false
     457                ,
     458                rv = POPs;
     459                if (rv && SvPOK(rv))
     460                  out = g_strdup(SvPV_nolen(rv));
     461                );
     462  return out;
    530463}
    531464
     
    538471{
    539472  SV *cb = owl_editwin_get_cbdata(e);
    540   SV *text;
    541   dSP;
    542 
    543   if(cb == NULL) {
     473  SV *text = owl_new_sv(owl_editwin_get_text(e));
     474
     475  if (cb == NULL) {
    544476    owl_function_error("Perl callback is NULL!");
    545477    return;
    546478  }
    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;
     479
     480  OWL_PERL_CALL(call_sv(cb, G_DISCARD|G_EVAL)
     481                ,
     482                XPUSHs(sv_2mortal(text));
     483                XPUSHs(sv_2mortal(newSViv(success)));
     484                ,
     485                "Perl Error: '%s'"
     486                ,
     487                false
     488                ,
     489                true
     490                ,
     491                );
    565492}
    566493
  • style.c

    r14be3a5 r92ffd89  
    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.