Changeset f248113


Ignore:
Timestamp:
Jun 22, 2013, 12:37:47 PM (11 years ago)
Author:
Jason Gross <jasongross9@gmail.com>
Parents:
1b17f50 (diff), 96d80e9 (diff)
Note: this is a merge changeset, the changes displayed below correspond to the merge itself.
Use the (diff) links above to see all the changes relative to each parent.
Message:
Merge 96d80e9b4aa667605b9c786b0272e1ab04dfbe9b into 1b17f506686dd0a0d0d433dec03180490d16d587
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 r96d80e9  
    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                );
     439}
     440
     441CALLER_OWN char *owl_perlconfig_perl_call(const char *method, int argc, const char *const *argv)
     442{
     443  SV *rv;
     444  char *out = NULL;
     445  int i;
     446  OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL)
     447                ,
     448                OWL_PERL_PUSH_ARGS(i, argc, argv);
     449                ,
     450                "Perl Error: '%s'"
     451                ,
     452                false
     453                ,
     454                false
     455                ,
     456                rv = POPs;
     457                if (rv && SvPOK(rv))
     458                  out = g_strdup(SvPV_nolen(rv));
     459                );
     460  return out;
     461}
     462
     463int owl_perlconfig_perl_call_int(const char *method, int argc, const char *const *argv)
     464{
     465  SV *rv;
     466  int ret = -1;
     467  int i;
     468  OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL)
     469                ,
     470                OWL_PERL_PUSH_ARGS(i, argc, argv);
     471                ,
     472                "Perl Error: '%s'"
     473                ,
     474                false
     475                ,
     476                false
     477                ,
     478                rv = POPs;
     479                if (rv && SvIOK(rv))
     480                  ret = SvIV(rv);
     481                );
     482  return ret;
     483}
     484
     485bool owl_perlconfig_perl_call_bool(const char *method, int argc, const char *const *argv)
     486{
     487  SV *rv;
     488  bool ret = false;
     489  int i;
     490  OWL_PERL_CALL(call_pv(method, G_SCALAR|G_EVAL)
     491                ,
     492                OWL_PERL_PUSH_ARGS(i, argc, argv);
     493                ,
     494                "Perl Error: '%s'"
     495                ,
     496                false
     497                ,
     498                false
     499                ,
     500                rv = POPs;
     501                if (rv)
     502                  ret = SvTRUE(rv);
     503                );
     504  return ret;
     505}
     506
     507void owl_perlconfig_perl_call_norv(const char *method, int argc, const char *const *argv)
     508{
     509  int i;
     510  OWL_PERL_CALL(call_pv(method, G_DISCARD|G_EVAL)
     511                ,
     512                OWL_PERL_PUSH_ARGS(i, argc, argv);
     513                ,
     514                "Perl Error: '%s'"
     515                ,
     516                false
     517                ,
     518                true
     519                ,
     520                );
    491521}
    492522
     
    494524CALLER_OWN char *owl_perlconfig_perlcmd(const owl_cmd *cmd, int argc, const char *const *argv)
    495525{
    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;
     526  int i;
     527  SV* rv;
     528  char *out = NULL;
     529
     530  OWL_PERL_CALL(call_sv(cmd->cmd_perl, G_SCALAR|G_EVAL)
     531                ,
     532                OWL_PERL_PUSH_ARGS(i, argc, argv);
     533                ,
     534                "Perl Error: '%s'"
     535                ,
     536                false
     537                ,
     538                false
     539                ,
     540                rv = POPs;
     541                if (rv && SvPOK(rv))
     542                  out = g_strdup(SvPV_nolen(rv));
     543                );
     544  return out;
    530545}
    531546
     
    538553{
    539554  SV *cb = owl_editwin_get_cbdata(e);
    540   SV *text;
    541   dSP;
    542 
    543   if(cb == NULL) {
     555  SV *text = owl_new_sv(owl_editwin_get_text(e));
     556
     557  if (cb == NULL) {
    544558    owl_function_error("Perl callback is NULL!");
    545559    return;
    546560  }
    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;
     561
     562  OWL_PERL_CALL(call_sv(cb, G_DISCARD|G_EVAL)
     563                ,
     564                XPUSHs(sv_2mortal(text));
     565                XPUSHs(sv_2mortal(newSViv(success)));
     566                ,
     567                "Perl Error: '%s'"
     568                ,
     569                false
     570                ,
     571                true
     572                ,
     573                );
    565574}
    566575
  • 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.