Changeset 92ffd89 for perlconfig.c


Ignore:
Timestamp:
Jun 22, 2013, 12:36:16 PM (8 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.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.