perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_interp.c modperl_interp.h modperl_types.h modperl_util.c modperl_util.h
Date Mon, 09 Apr 2001 23:57:23 GMT
dougm       01/04/09 16:57:23

  Modified:    src/modules/perl mod_perl.c modperl_interp.c
                        modperl_interp.h modperl_types.h modperl_util.c
                        modperl_util.h
  Log:
  implement "the dso fix" 2.0 style
  
  Revision  Changes    Path
  1.43      +15 -2     modperl-2.0/src/modules/perl/mod_perl.c
  
  Index: mod_perl.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
  retrieving revision 1.42
  retrieving revision 1.43
  diff -u -r1.42 -r1.43
  --- mod_perl.c	2001/04/06 02:18:15	1.42
  +++ mod_perl.c	2001/04/09 23:57:22	1.43
  @@ -3,12 +3,21 @@
   #ifndef USE_ITHREADS
   static apr_status_t modperl_shutdown(void *data)
   {
  -    PerlInterpreter *perl = (PerlInterpreter *)data;
  +    modperl_cleanup_data_t *cdata = (modperl_cleanup_data_t *)data;
  +    PerlInterpreter *perl = (PerlInterpreter *)cdata->data;
  +    apr_array_header_t *handles;
  +
       PL_perl_destruct_level = 2;
       MP_TRACE_i(MP_FUNC, "destroying interpreter=0x%lx\n",
                  (unsigned long)perl);
  +
       perl_destruct(perl);
       perl_free(perl);
  +
  +    if ((handles = modperl_xs_dl_handles_get(cdata->pool)) {
  +        modperl_xs_dl_handles_close(handles);
  +    }
  +
       return APR_SUCCESS;
   }
   #endif
  @@ -20,6 +29,9 @@
       int status;
       char **argv;
       int argc;
  +#ifndef USE_ITHREADS
  +    modperl_cleanup_data_t *cdata;
  +#endif
   
   #ifdef MP_USE_GTOP
       MP_TRACE_m_do(
  @@ -61,7 +73,8 @@
   #endif
   
   #ifndef USE_ITHREADS
  -    apr_pool_cleanup_register(p, (void*)perl,
  +    cdata = modperl_cleanup_data_new(p, (void*)perl);
  +    apr_pool_cleanup_register(p, cdata,
                                 modperl_shutdown, apr_pool_cleanup_null);
   #endif
       
  
  
  
  1.31      +37 -8     modperl-2.0/src/modules/perl/modperl_interp.c
  
  Index: modperl_interp.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
  retrieving revision 1.30
  retrieving revision 1.31
  diff -u -r1.30 -r1.31
  --- modperl_interp.c	2001/04/06 02:18:15	1.30
  +++ modperl_interp.c	2001/04/09 23:57:22	1.31
  @@ -16,6 +16,25 @@
       return MP_interp_scope_desc[scope];
   }
   
  +void modperl_interp_clone_init(modperl_interp_t *interp)
  +{
  +    dTHXa(interp->perl);
  +
  +    MpInterpCLONED_On(interp);
  +
  +    PERL_SET_CONTEXT(aTHX);
  +
  +    /* XXX: hack for bug fixed in 5.6.1 */
  +    if (PL_scopestack_ix == 0) {
  +        ENTER;
  +    }
  +
  +    /* clear @DynaLoader::dl_librefs so we only dlclose() those
  +     * which are opened by the clone
  +     */
  +    modperl_xs_dl_handles_clear(aTHX);
  +}
  +
   modperl_interp_t *modperl_interp_new(apr_pool_t *p,
                                        modperl_interp_pool_t *mip,
                                        PerlInterpreter *perl)
  @@ -35,15 +54,8 @@
   
           interp->perl = perl_clone(perl, FALSE);
   
  -        {
  -            /* XXX: hack for bug fixed in 5.6.1 */
  -            dTHXa(interp->perl);
  -            if (PL_scopestack_ix == 0) {
  -                ENTER;
  -            }
  -        }
  +        modperl_interp_clone_init(interp);
   
  -        MpInterpCLONED_On(interp);
           PERL_SET_CONTEXT(mip->parent->perl);
   
   #ifdef MP_USE_GTOP
  @@ -60,6 +72,8 @@
   
   void modperl_interp_destroy(modperl_interp_t *interp)
   {
  +    apr_pool_t *p = NULL;
  +    apr_array_header_t *handles;
       dTHXa(interp->perl);
   
       MP_TRACE_i(MP_FUNC, "interp == 0x%lx\n",
  @@ -71,8 +85,23 @@
   
       PERL_SET_CONTEXT(interp->perl);
       PL_perl_destruct_level = 2;
  +
  +    /* we cant use interp->mip->ap_pool without locking
  +     * apr_pool_create() will mutex lock for us
  +     * XXX: could roll something without using apr_pool_t
  +     * to avoid locking
  +     */
  +    (void)apr_pool_create(&p, NULL);
  +    handles = modperl_xs_dl_handles_get(aTHX_ p);
  +
       perl_destruct(interp->perl);
       perl_free(interp->perl);
  +
  +    if (handles) {
  +        modperl_xs_dl_handles_close(handles);
  +    }
  +
  +    apr_pool_destroy(p);
   }
   
   apr_status_t modperl_interp_cleanup(void *data)
  
  
  
  1.11      +2 -0      modperl-2.0/src/modules/perl/modperl_interp.h
  
  Index: modperl_interp.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.h,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- modperl_interp.h	2001/04/06 02:18:15	1.10
  +++ modperl_interp.h	2001/04/09 23:57:22	1.11
  @@ -9,6 +9,8 @@
   #ifdef USE_ITHREADS
   const char *modperl_interp_scope_desc(modperl_interp_scope_e scope);
   
  +void modperl_interp_clone_init(modperl_interp_t *interp);
  +
   modperl_interp_t *modperl_interp_new(apr_pool_t *p,
                                        modperl_interp_pool_t *mip,
                                        PerlInterpreter *perl);
  
  
  
  1.34      +5 -0      modperl-2.0/src/modules/perl/modperl_types.h
  
  Index: modperl_types.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
  retrieving revision 1.33
  retrieving revision 1.34
  diff -u -r1.33 -r1.34
  --- modperl_types.h	2001/04/06 02:18:15	1.33
  +++ modperl_types.h	2001/04/09 23:57:22	1.34
  @@ -205,4 +205,9 @@
       MpAV *handlers_connection[MP_HANDLER_NUM_CONNECTION];
   } modperl_config_con_t;
   
  +typedef struct {
  +    apr_pool_t *pool;
  +    void *data;
  +} modperl_cleanup_data_t;
  +
   #endif /* MODPERL_TYPES_H */
  
  
  
  1.6       +78 -0     modperl-2.0/src/modules/perl/modperl_util.c
  
  Index: modperl_util.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- modperl_util.c	2001/03/14 04:22:51	1.5
  +++ modperl_util.c	2001/04/09 23:57:22	1.6
  @@ -86,3 +86,81 @@
   {
       return apr_psprintf(p, "%s:%u", s->server_hostname, s->port);
   }
  +
  +#define dl_librefs "DynaLoader::dl_librefs"
  +#define dl_modules "DynaLoader::dl_modules"
  +
  +void modperl_xs_dl_handles_clear(pTHXo)
  +{
  +    AV *librefs = get_av(dl_librefs, FALSE);
  +    if (librefs) {
  +        av_clear(librefs);
  +    }
  +}
  +
  +apr_array_header_t *modperl_xs_dl_handles_get(pTHX_ apr_pool_t *p)
  +{
  +    I32 i;
  +    AV *librefs = get_av(dl_librefs, FALSE);
  +    AV *modules = get_av(dl_modules, FALSE);
  +    apr_array_header_t *handles;
  +
  +    if (!librefs) {
  +	MP_TRACE_g(MP_FUNC,
  +                   "Could not get @%s for unloading.\n",
  +                   dl_librefs);
  +	return NULL;
  +    }
  +
  +    handles = apr_array_make(p, AvFILL(librefs)-1, sizeof(void *));
  +
  +    for (i=0; i<=AvFILL(librefs); i++) {
  +	void *handle;
  +	SV *handle_sv = *av_fetch(librefs, i, FALSE);
  +	SV *module_sv = *av_fetch(modules, i, FALSE);
  +
  +	if(!handle_sv) {
  +	    MP_TRACE_g(MP_FUNC,
  +                       "Could not fetch $%s[%d]!\n",
  +                       dl_librefs, (int)i);
  +	    continue;
  +	}
  +	handle = (void *)SvIV(handle_sv);
  +
  +	MP_TRACE_g(MP_FUNC, "%s dl handle == 0x%lx\n",
  +                   SvPVX(module_sv), (unsigned long)handle);
  +	if (handle) {
  +	    *(void **)apr_array_push(handles) = handle;
  +	}
  +    }
  +
  +    av_clear(modules);
  +    av_clear(librefs);
  +
  +    return handles;
  +}
  +
  +void modperl_xs_dl_handles_close(apr_array_header_t *handles)
  +{
  +    int i;
  +
  +    if (!handles) {
  +	return;
  +    }
  +
  +    for (i=0; i < handles->nelts; i++) {
  +	void *handle = ((void **)handles->elts)[i];
  +	MP_TRACE_g(MP_FUNC, "close 0x%lx\n",
  +                   (unsigned long)handle);
  +	dlclose(handle); /*XXX*/
  +    }
  +}
  +
  +modperl_cleanup_data_t *modperl_cleanup_data_new(apr_pool_t *p, void *data)
  +{
  +    modperl_cleanup_data_t *cdata =
  +        (modperl_cleanup_data_t *)apr_pcalloc(p, sizeof(*cdata));
  +    cdata->pool = p;
  +    cdata->data = data;
  +    return cdata;
  +}
  
  
  
  1.7       +8 -0      modperl-2.0/src/modules/perl/modperl_util.h
  
  Index: modperl_util.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- modperl_util.h	2001/03/14 05:22:50	1.6
  +++ modperl_util.h	2001/04/09 23:57:22	1.7
  @@ -29,4 +29,12 @@
   
   char *modperl_server_desc(server_rec *s, apr_pool_t *p);
   
  +void modperl_xs_dl_handles_clear(pTHXo);
  +
  +apr_array_header_t *modperl_xs_dl_handles_get(pTHX_ apr_pool_t *p);
  +
  +void modperl_xs_dl_handles_close(apr_array_header_t *handles);
  +
  +modperl_cleanup_data_t *modperl_cleanup_data_new(apr_pool_t *p, void *data);
  +
   #endif /* MODPERL_UTIL_H */
  
  
  

Mime
View raw message