Re: Interpreter scope

[Torsten Foertsch]

On Monday 23 April 2007 07:08, Philippe M. Chiasson wrote:
> > Is there something like $r->release_interp_after_this_phase()?
>
> Nope, but writing one would be very simple, all that's needed is
> to call
>
>   MpInterpPUTBACK_On(interp)
>

    apr_pool_cleanup_kill(r->pool, r, modperl_config_req_cleanup);
    modperl_interp_pool_set(r->pool, NULL, 0);
    interp->request=r;
    MpInterpPUTBACK_On(interp);
    MpReqCLEANUP_REGISTERED_On(rcfg);

I think this turns a per-request interpreter into a per-handler one. I have 
attached a first version of an Apache2::Interpreter module that implements 
$r->interpreter->release.

The most tricky part for me was to find the correct interp. Could you please 
have a look at that? Maybe it could be done much simpler.

Also, the cleanup stuff is buggy as it is with scope==handler. 
$r->pool->cleanup_register works by locking the interp until pool cleanup. It 
thus blocks the interp from being reused. PerlCleanupHandler does not work at 
all.

Torsten

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "mod_perl.h"
#include "mod_include.h"

typedef request_rec *Apache2__RequestRec;
typedef modperl_interp_t *Apache2__Interpreter;

static modperl_interp_t *
get_interpreter( pTHX_ request_rec *r )
{
  MP_dRCFG;
  MP_dSCFG(r->server);
  modperl_tipool_t *tipool;
  modperl_list_t *lp;
  modperl_interp_t *interp;

  if( !modperl_threaded_mpm() ) {
    return scfg->mip->parent;
  }

#ifdef USE_ITHREADS
  if( rcfg && rcfg->interp && rcfg->interp->perl==aTHX ) {
    MP_TRACE_i(MP_FUNC,
	       "get_interpreter: found interp 0x%lx in request config\n",
	       (unsigned long)rcfg->interp);
    return rcfg->interp;
  }

  if( (interp=modperl_interp_pool_get( r->pool )) &&
      interp->perl==aTHX ) {
    MP_TRACE_i(MP_FUNC,
	       "get_interpreter: found interp 0x%lx in request pool\n",
	       (unsigned long)interp);
    return interp;
  }

  if( (interp=modperl_interp_pool_get( r->connection->pool )) &&
      interp->perl==aTHX ) {
    MP_TRACE_i(MP_FUNC,
	       "get_interpreter: found interp 0x%lx in connection pool\n",
	       (unsigned long)interp);
    return interp;
  }

  if( r->main ) {
    request_rec *main_r=r->main;
    while( main_r ) {
      if( (interp=modperl_interp_pool_get( main_r->pool )) &&
	  interp->perl==aTHX ) {
	MP_TRACE_i(MP_FUNC,
		   "get_interpreter: found interp 0x%lx in connection pool\n",
		   (unsigned long)interp);
	return interp;
      }
      main_r=main_r->main;
    }
  }

  /* worst case: lock interpreter pool and loop over all busy interpreters */
  tipool=scfg->mip->tipool;
  modperl_tipool_lock(tipool);
  for( lp=tipool->busy; lp; lp=lp->next ) {
    interp=(modperl_interp_t *)(lp->data);
    if( interp && interp->perl==aTHX ) break;
  }
  modperl_tipool_unlock(tipool);

  if( interp && interp->perl==aTHX ) {
    MP_TRACE_i(MP_FUNC,
	       "get_interpreter: found interp 0x%lx in interpreter pool\n",
	       (unsigned long)interp);
    return interp;
  } else {
    MP_TRACE_i(MP_FUNC,
	       "get_interpreter: no interp found\n");
    return 0;
  }
# else	/* USE_ITHREADS */
  return 0;
# endif	/* USE_ITHREADS */
}

MODULE = Apache2::Interpreter    PACKAGE = Apache2::RequestRec

Apache2::Interpreter
interpreter(r)
    Apache2::RequestRec r
PROTOTYPE: $
CODE:
  {
    RETVAL=get_interpreter(aTHX_ r);
  }
OUTPUT:
    RETVAL

MODULE = Apache2::Interpreter    PACKAGE = Apache2::Interpreter

unsigned long
perl(interp)
    Apache2::Interpreter interp
PROTOTYPE: $
CODE:
  {
    RETVAL=(unsigned long)interp->perl;
  }
OUTPUT:
    RETVAL

int
num_requests(interp)
    Apache2::Interpreter interp
PROTOTYPE: $
CODE:
  {
    RETVAL=interp->num_requests;
  }
OUTPUT:
    RETVAL

U8
flags(interp)
    Apache2::Interpreter interp
PROTOTYPE: $
CODE:
  {
    RETVAL=interp->flags;
  }
OUTPUT:
    RETVAL

int
refcnt(interp)
    Apache2::Interpreter interp
PROTOTYPE: $
CODE:
  {
    RETVAL=interp->refcnt;
  }
OUTPUT:
    RETVAL

Apache2::RequestRec
request(interp)
    Apache2::Interpreter interp
PROTOTYPE: $
CODE:
  {
    RETVAL=interp->request;
  }
OUTPUT:
    RETVAL

#ifdef MP_TRACE

unsigned long
tid(interp)
    Apache2::Interpreter interp
PROTOTYPE: $
CODE:
  {
    RETVAL=interp->tid;
  }
OUTPUT:
    RETVAL

#endif

int
release(interp, r)
    Apache2::Interpreter interp
    Apache2::RequestRec r
PROTOTYPE: $
CODE:
  {
    MP_dRCFG;

    apr_pool_cleanup_kill(r->pool, r, modperl_config_req_cleanup);
    modperl_interp_pool_set(r->pool, NULL, 0);
    interp->request=r;
    MpInterpPUTBACK_On(interp);
    MpReqCLEANUP_REGISTERED_On(rcfg);

    RETVAL=0;
  }
OUTPUT:
    RETVAL

MODULE = Apache2::Interpreter

## Local Variables: ##
## mode: c ##
## End: ##

pgpcTwrU5aAGW.pgp
Description: PGP signature