cvs commit: modperl-2.0/src/modules/perl modperl_callback.c

[st...@apache.org]

stas        2003/09/18 00:46:26

  Modified:    src/modules/perl modperl_callback.c
  Log:
  put the end to the 'Not a CODE reference' errors, instead provide an
  intelligent error message, hopefully telling which function can't be found.
  at the same time improve the tracing to include the pid/tid of the server
  that has encountered this problem, to make it easier to debug
  
  Revision  Changes    Path
  1.58      +36 -16    modperl-2.0/src/modules/perl/modperl_callback.c
  
  Index: modperl_callback.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
  retrieving revision 1.57
  retrieving revision 1.58
  diff -u -u -r1.57 -r1.58
  --- modperl_callback.c	13 Sep 2003 20:35:33 -0000	1.57
  +++ modperl_callback.c	18 Sep 2003 07:46:26 -0000	1.58
  @@ -6,7 +6,7 @@
       CV *cv=Nullcv;
       I32 flags = G_EVAL|G_SCALAR;
       dSP;
  -    int count, status;
  +    int count, status = OK;
   
       if ((status = modperl_handler_resolve(aTHX_ &handler, p, s)) != OK) {
           return status;
  @@ -45,28 +45,46 @@
               cv = modperl_mgv_cv(gv);
           }
           else {
  -            char *name = modperl_mgv_as_string(aTHX_ handler->mgv_cv, p, 0);
  -            MP_TRACE_h(MP_FUNC, "lookup of %s failed\n", name);
  +            
  +            const char *name;
  +            modperl_mgv_t *symbol = handler->mgv_cv;
  +            
  +             /* XXX: need to validate *symbol */
  +            if (symbol && symbol->name) {
  +                name = modperl_mgv_as_string(aTHX_ symbol, p, 0);
  +            }
  +            else {
  +                name = handler->name;
  +            }
  +            
  +            MP_TRACE_h(MP_FUNC, "[%s %s] lookup of %s failed\n",
  +                         modperl_pid_tid(p), modperl_server_desc(s, p), name);
  +            ap_log_error(APLOG_MARK, APLOG_ERR, 0, s,
  +                         "lookup of '%s' failed\n", name);
  +            status = HTTP_INTERNAL_SERVER_ERROR;
           }
       }
   
  -    count = call_sv((SV*)cv, flags);
  +    if (status == OK) {
  +        count = call_sv((SV*)cv, flags);
   
  -    SPAGAIN;
  +        SPAGAIN;
   
  -    if (count != 1) {
  -        status = OK;
  -    }
  -    else {
  -        status = POPi;
  -        /* assume OK for non-http status codes and for 200 (HTTP_OK) */
  -        if (((status > 0) && (status < 100)) ||
  -            (status == 200) || (status > 600)) {
  +        if (count != 1) {
               status = OK;
           }
  -    }
  +        else {
  +            status = POPi;
  +            /* assume OK for non-http status codes and for 200 (HTTP_OK) */
  +            if (((status > 0) && (status < 100)) ||
  +                (status == 200) || (status > 600)) {
  +                status = OK;
  +            }
  +        }
   
  -    PUTBACK;
  +        PUTBACK;
  +    }
  +    
       FREETMPS;LEAVE;
   
       if (SvTRUE(ERRSV)) {
  @@ -181,7 +199,8 @@
        * different handler e.g. jumping from 'modperl' to 'perl-script',
        * before calling push_handler */
       nelts = av->nelts;
  -    MP_TRACE_h(MP_FUNC, "running %d %s handlers\n", nelts, desc);
  +    MP_TRACE_h(MP_FUNC, "[%s] running %d %s handlers\n",
  +               modperl_pid_tid(p), nelts, desc);
       handlers = (modperl_handler_t **)av->elts;
   
       for (i=0; i<nelts; i++) {
  @@ -248,6 +267,7 @@
   
       SvREFCNT_dec((SV*)av_args);
   
  +    /* PerlInterpScope handler */
   #ifdef USE_ITHREADS
       MP_dINTERP_PUTBACK(interp);
   #endif