cvs commit: modperl-2.0/xs/Apache/RequestIO Apache__RequestIO.h

[dougm]

dougm   01/04/30 00:17:50

  Modified:lib/ModPerl WrapXS.pm
   src/modules/perl mod_perl.h modperl_util.c modperl_util.h
   xs   typemap
   xs/Apache/RequestIO Apache__RequestIO.h
  Added:   t/response/TestAPI r_subclass.pm
  Log:
  support subclassing of Apache::RequestRec
  
  Revision  ChangesPath
  1.11  +6 -1  modperl-2.0/lib/ModPerl/WrapXS.pm
  
  Index: WrapXS.pm
  ===
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- WrapXS.pm 2001/04/28 23:03:07 1.10
  +++ WrapXS.pm 2001/04/30 07:17:45 1.11
  @@ -467,6 +467,10 @@
   EOF
   }
   
  +my %typemap = (
  +'Apache::RequestRec' => 'T_APACHEOBJ',
  +);
  +
   sub write_typemap {
   my $self = shift;
   my $typemap = $self->typemap;
  @@ -481,7 +485,8 @@
   next if $seen{$type}++ || $typemap->special($class);
   
   if ($class =~ /::/) {
  -print $fh "$class\tT_PTROBJ\n";
  +my $typemap = $typemap{$class} || 'T_PTROBJ';
  +print $fh "$class\t$typemap\n";
   }
   else {
   print $fh "$type\tT_$class\n";
  
  
  
  1.31  +2 -0  modperl-2.0/src/modules/perl/mod_perl.h
  
  Index: mod_perl.h
  ===
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v
  retrieving revision 1.30
  retrieving revision 1.31
  diff -u -r1.30 -r1.31
  --- mod_perl.h2001/04/30 04:38:35 1.30
  +++ mod_perl.h2001/04/30 07:17:46 1.31
  @@ -49,4 +49,6 @@
*/
   #define MP_CODE_ATTRS(cv) (CvXSUBANY((CV*)cv).any_i32)
   
  +#define MgTypeExt(mg) (mg->mg_type == '~')
  +
   #endif /*  MOD_PERL_H */
  
  
  
  1.11  +77 -4 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.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- modperl_util.c2001/04/28 22:35:20 1.10
  +++ modperl_util.c2001/04/30 07:17:46 1.11
  @@ -25,15 +25,88 @@
   return TRUE;
   }
   
  +static SV *modperl_hv_request_find(pTHX_ SV *in, char *classname, CV *cv)
  +{
  +static char *r_keys[] = { "r", "_r", NULL };
  +HV *hv = (HV *)SvRV(in);
  +SV *sv = Nullsv;
  +int i;
  +
  +for (i=0; r_keys[i]; i++) {
  +int klen = i + 1; /* assumes r_keys[] will never change */
  +SV **svp;
  +
  +if ((svp = hv_fetch(hv, r_keys[i], klen, FALSE)) && (sv = *svp)) {
  +if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVHV)) {
  +/* dig deeper */
  +return modperl_hv_request_find(aTHX_ sv, classname, cv);
  +}
  +break;
  +}
  +}
  +
  +if (!sv) {
  +Perl_croak(aTHX_
  +   "method `%s' invoked by a `%s' object with no `r' key!",
  +   cv ? GvNAME(CvGV(cv)) : "unknown",
  +   HvNAME(SvSTASH(SvRV(in;
  +}
  +
  +return SvROK(sv) ? SvRV(sv) : sv;
  +}
  +
   MP_INLINE request_rec *modperl_sv2request_rec(pTHX_ SV *sv)
  +{
  +return modperl_xs_sv2request_rec(aTHX_ sv, NULL, Nullcv);
  +}
  +
  +request_rec *modperl_xs_sv2request_rec(pTHX_ SV *in, char *classname, CV *cv)
   {
  -request_rec *r = NULL;
  +SV *sv = Nullsv;
  +MAGIC *mg;
   
  -if (SvROK(sv) && (SvTYPE(SvRV(sv)) == SVt_PVMG)) {
  -r = (request_rec *)SvIV((SV*)SvRV(sv));
  +if (in == &PL_sv_undef) {
  +return NULL;
  +}
  +
  +if (SvROK(in)) {
  +SV *rv = (SV*)SvRV(in);
  +
  +switch (SvTYPE(rv)) {
  +  case SVt_PVMG:
  +sv = rv;
  +break;
  +  case SVt_PVHV:
  +sv = modperl_hv_request_find(aTHX_ in, classname, cv);
  +break;
  +  default:
  +Perl_croak(aTHX_ "panic: unsupported request_rec type %d",
  +   SvTYPE(rv));
  +}
  +}
  +
  +if (!sv) {
  +request_rec *r = NULL;
  +(void)modperl_tls_get_request_rec(&r);
  +
  +if (!r) {
  +Perl_croak(aTHX_
  +   "Apache->%s called without setting Apache->request!",
  +   cv ? GvNAME(CvGV(cv)) : "unknown");
  +}
  +
  +return r;
  +}
  +
  +/* XXX: not checking sv_derived_from(sv, classname); for speed */
  +if ((mg = SvMAGIC(sv))) {
  +return MgTypeExt(mg) ? (request_rec *)mg->mg_ptr : NULL;
  +}
  +else {
  +return (request_rec *)SvIV(sv);
   }
   
  -return r;
  +return NULL;
   }
   
   MP_INLINE SV *modperl_newSVsv_obj(pTHX_ SV *stashsv, SV *obj)
  
  
  
  1.13  +2 -0  modperl-2.0/src/mod

cvs commit: modperl-2.0/xs/maps modperl_functions.map

[dougm]

dougm   01/04/29 21:39:30

  Modified:t/conf   modperl_extra.pl
   t/response/TestAPI request_rec.pm
   xs/Apache/RequestUtil Apache__RequestUtil.h
   xs/maps  modperl_functions.map
  Log:
  add Apache->request method and tests
  
  Revision  ChangesPath
  1.6   +1 -0  modperl-2.0/t/conf/modperl_extra.pl
  
  Index: modperl_extra.pl
  ===
  RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- modperl_extra.pl  2001/04/19 21:26:38 1.5
  +++ modperl_extra.pl  2001/04/30 04:39:24 1.6
  @@ -1,5 +1,6 @@
   use Apache::RequestRec ();
   use Apache::RequestIO ();
  +use Apache::RequestUtil ();
   
   use Apache::Server ();
   use Apache::Connection ();
  
  
  
  1.3   +16 -1 modperl-2.0/t/response/TestAPI/request_rec.pm
  
  Index: request_rec.pm
  ===
  RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/request_rec.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- request_rec.pm2001/04/03 16:59:09 1.2
  +++ request_rec.pm2001/04/30 04:39:26 1.3
  @@ -8,8 +8,21 @@
   sub handler {
   my $r = shift;
   
  -plan $r, tests => 33;
  +plan $r, tests => 35;
   
  +#Apache->request($r); #PerlOptions +GlobalRequest takes care
  +my $gr = Apache->request;
  +
  +ok $$gr == $$r;
  +
  +my $newr = Apache::RequestRec->new($r->connection, $r->pool);
  +Apache->request($newr);
  +$gr = Apache->request;
  +
  +ok $$gr == $$newr;
  +
  +Apache->request($r);
  +
   ok $r->pool->isa('APR::Pool');
   
   ok $r->connection->isa('Apache::Connection');
  @@ -101,3 +114,5 @@
   }
   
   1;
  +__END__
  +PerlOptions +GlobalRequest
  
  
  
  1.5   +20 -0 modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h
  
  Index: Apache__RequestUtil.h
  ===
  RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestUtil/Apache__RequestUtil.h,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- Apache__RequestUtil.h 2001/04/28 22:42:55 1.4
  +++ Apache__RequestUtil.h 2001/04/30 04:39:27 1.5
  @@ -80,7 +80,27 @@
   r->err_headers_out = apr_table_make(p, 1);
   r->notes = apr_table_make(p, 1);
   
  +ap_run_create_request(r);
  +
   return r;
  +}
  +
  +static MP_INLINE
  +request_rec *mpxs_Apache_request(SV *classname, SV *svr)
  +{
  +request_rec *cur;
  +apr_status_t status = modperl_tls_get_request_rec(&cur);
  +
  +if (status != APR_SUCCESS) {
  +/* XXX: croak */
  +}
  +
  +if (svr) {
  +dTHX; /*XXX*/
  +modperl_global_request_obj_set(aTHX_ svr);
  +}
  +
  +return cur;
   }
   
   static MP_INLINE
  
  
  
  1.9   +2 -0  modperl-2.0/xs/maps/modperl_functions.map
  
  Index: modperl_functions.map
  ===
  RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- modperl_functions.map 2001/04/28 22:42:56 1.8
  +++ modperl_functions.map 2001/04/30 04:39:29 1.9
  @@ -10,6 +10,8 @@
mpxs_Apache__RequestRec_set_basic_credentials
   PACKAGE=Apache::RequestRec
mpxs_Apache__RequestRec_new | | classname, c, base_pool=NULL
  +PACKAGE=Apache
  + mpxs_Apache_request | | classname, svr=Nullsv
   
   MODULE=Apache::RequestIO   PACKAGE=Apache::RequestRec
SV *:DEFINE_TIEHANDLE   | | SV *:stashsv, SV *:sv=Nullsv
  
  
  

cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h modperl_types.h

[dougm]

dougm   01/04/29 21:38:37

  Modified:src/modules/perl mod_perl.c mod_perl.h modperl_types.h
  Log:
  integrate modperl_global module and initialize pconf/request_rec globals
  
  Revision  ChangesPath
  1.51  +13 -0 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.50
  retrieving revision 1.51
  diff -u -r1.50 -r1.51
  --- mod_perl.c2001/04/25 16:19:44 1.50
  +++ mod_perl.c2001/04/30 04:38:34 1.51
  @@ -207,6 +207,12 @@
   }
   #endif /* USE_ITHREADS */
   
  +static void modperl_init_globals(apr_pool_t *pconf)
  +{
  +modperl_global_init_pconf(pconf, (void *)pconf);
  +modperl_tls_create_request_rec(pconf);
  +}
  +
   void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog, 
  apr_pool_t *ptemp, server_rec *s)
   {
  @@ -237,6 +243,7 @@
   ap_add_version_component(pconf,
Perl_form(aTHX_ "Perl/v%vd", PL_patchlevel));
   modperl_mgv_hash_handlers(pconf, s);
  +modperl_init_globals(pconf);
   #ifdef USE_ITHREADS
   modperl_init_clones(s, pconf);
   #endif
  @@ -253,11 +260,17 @@
   
   static int modperl_hook_post_read_request(request_rec *r)
   {
  +/* if 'PerlOptions +GlobalRequest' is outside a container */
  +modperl_global_request_cfg_set(r);
  +
   return modperl_input_filter_register_request(r);
   }
   
   static int modperl_hook_header_parser(request_rec *r)
   {
  +/* if 'PerlOptions +GlobalRequest' is inside a container */
  +modperl_global_request_cfg_set(r);
  +
   return modperl_input_filter_register_request(r);
   }
   
  
  
  
  1.30  +3 -0  modperl-2.0/src/modules/perl/mod_perl.h
  
  Index: mod_perl.h
  ===
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v
  retrieving revision 1.29
  retrieving revision 1.30
  diff -u -r1.29 -r1.30
  --- mod_perl.h2001/04/19 21:26:34 1.29
  +++ mod_perl.h2001/04/30 04:38:35 1.30
  @@ -4,6 +4,8 @@
   #include "modperl_apache_includes.h"
   #include "modperl_perl_includes.h"
   
  +#define MP_THREADED (defined(USE_ITHREADS) && APR_HAS_THREADS)
  +
   extern module AP_MODULE_DECLARE_DATA perl_module;
   
   #include "modperl_flags.h"
  @@ -27,6 +29,7 @@
   #include "modperl_filter.h"
   #include "modperl_pcw.h"
   #include "modperl_mgv.h"
  +#include "modperl_global.h"
   
   void modperl_init(server_rec *s, apr_pool_t *p);
   void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog, 
  
  
  
  1.39  +2 -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.38
  retrieving revision 1.39
  diff -u -r1.38 -r1.39
  --- modperl_types.h   2001/04/28 23:03:08 1.38
  +++ modperl_types.h   2001/04/30 04:38:35 1.39
  @@ -197,6 +197,8 @@
   
   typedef struct {
   HV *pnotes;
  +SV *global_request_obj;
  +U8 flags;
   modperl_wbucket_t wbucket;
   MpAV *handlers_per_dir[MP_HANDLER_NUM_PER_DIR];
   MpAV *handlers_per_srv[MP_HANDLER_NUM_PER_SRV];
  
  
  

cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm

[dougm]

dougm   01/04/29 21:37:32

  Modified:xs/tables/current/ModPerl FunctionTable.pm
  Log:
  sync
  
  Revision  ChangesPath
  1.13  +224 -1modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
  
  Index: FunctionTable.pm
  ===
  RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
  retrieving revision 1.12
  retrieving revision 1.13
  diff -u -r1.12 -r1.13
  --- FunctionTable.pm  2001/04/29 17:53:42 1.12
  +++ FunctionTable.pm  2001/04/30 04:37:31 1.13
  @@ -2,7 +2,7 @@
   
   # !!
   # ! WARNING: generated by ModPerl::ParseSource/0.01
  -# !  Sun Apr 29 10:27:28 2001
  +# !  Sun Apr 29 20:13:39 2001
   # !  do NOT edit, any changes will be lost !
   # !!
   
  @@ -2298,6 +2298,215 @@
   'return_type' => 'void',
   'args' => [
 {
  +'name' => 'global',
  +'type' => 'modperl_global_t *'
  +  },
  +  {
  +'name' => 'p',
  +'type' => 'apr_pool_t *'
  +  },
  +  {
  +'name' => 'data',
  +'type' => 'void *'
  +  },
  +  {
  +'name' => 'name',
  +'type' => 'const char *'
  +  }
  +],
  +'name' => 'modperl_global_init'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [
  +  {
  +'name' => 'global',
  +'type' => 'modperl_global_t *'
  +  }
  +],
  +'name' => 'modperl_global_lock'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [
  +  {
  +'name' => 'global',
  +'type' => 'modperl_global_t *'
  +  }
  +],
  +'name' => 'modperl_global_unlock'
  +  },
  +  {
  +'return_type' => 'void *',
  +'args' => [
  +  {
  +'name' => 'global',
  +'type' => 'modperl_global_t *'
  +  }
  +],
  +'name' => 'modperl_global_get'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [
  +  {
  +'name' => 'global',
  +'type' => 'modperl_global_t *'
  +  },
  +  {
  +'name' => 'data',
  +'type' => 'void *'
  +  }
  +],
  +'name' => 'modperl_global_set'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [
  +  {
  +'name' => 'p',
  +'type' => 'apr_pool_t *'
  +  },
  +  {
  +'name' => 'pconf',
  +'type' => 'apr_pool_t *'
  +  }
  +],
  +'name' => 'modperl_global_init_pconf'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [],
  +'name' => 'modperl_global_lock_pconf'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [],
  +'name' => 'modperl_global_unlock_pconf'
  +  },
  +  {
  +'return_type' => 'apr_pool_t *',
  +'args' => [],
  +'name' => 'modperl_global_get_pconf'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [
  +  {
  +'name' => 'arg0',
  +'type' => 'void *'
  +  }
  +],
  +'name' => 'modperl_global_set_pconf'
  +  },
  +  {
  +'return_type' => 'apr_status_t',
  +'args' => [
  +  {
  +'name' => 'p',
  +'type' => 'apr_pool_t *'
  +  },
  +  {
  +'name' => 'key',
  +'type' => 'modperl_tls_t **'
  +  }
  +],
  +'name' => 'modperl_tls_create'
  +  },
  +  {
  +'return_type' => 'apr_status_t',
  +'args' => [
  +  {
  +'name' => 'key',
  +'type' => 'modperl_tls_t *'
  +  },
  +  {
  +'name' => 'data',
  +'type' => 'void **'
  +  }
  +],
  +'name' => 'modperl_tls_get'
  +  },
  +  {
  +'return_type' => 'apr_status_t',
  +'args' => [
  +  {
  +'name' => 'key',
  +'type' => 'modperl_tls_t *'
  +  },
  +  {
  +'name' => 'data',
  +'type' => 'void *'
  +  }
  +],
  +'name' => 'modperl_tls_set'
  +  },
  +  {
  +'return_type' => 'void',
  +'args' => [
  +  {
  +'name' => 'p',
  +'type' => 'apr_pool_t *'
  +  },
  +  {
  +'name' => 'key',
  +'type' => 'modperl_tls_t *'
  +  },
  +  {
  +'name' => 'data',
  +'type' => 'void *'
  +  }
  +],
  +'name' => 'modperl_tls_reset_cleanup'
  +  },
  +  {
  +'return_type' => 'apr_status_t',
  +'args' => [
  +  {
  +'name' => 'p',
  +'type' => 'apr_pool_t *'
  +  }
  +],
  +'name' => 'modperl_tls_create_request_rec'
  +  },
  +  {
  +'return_type' => 'apr_status_t',
  +'args' => [
  +  {
  +'name' => 'data',
  +'type' => 'request_rec * *'
  +  }
  +],
  +'name' => 'modperl_tls_get_request_rec'
  +  },
  +  {
  +'return_type' => 'apr_status_t',
  +'args' => [
  +  {
  +'name' => 'data',
  +'type' => 'void *'
  +  }
 

cvs commit: modperl-2.0/lib/ModPerl Code.pm

[dougm]

dougm   01/04/29 21:37:01

  Modified:lib/ModPerl Code.pm
  Log:
  integrate modperl_global module
  
  Revision  ChangesPath
  1.60  +3 -2  modperl-2.0/lib/ModPerl/Code.pm
  
  Index: Code.pm
  ===
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
  retrieving revision 1.59
  retrieving revision 1.60
  diff -u -r1.59 -r1.60
  --- Code.pm   2001/04/19 17:42:16 1.59
  +++ Code.pm   2001/04/30 04:37:00 1.60
  @@ -93,7 +93,8 @@
   my %flags = (
   Srv => ['NONE', @ithread_opts, qw(ENABLED AUTOLOAD MERGE_HANDLERS),
   @hook_flags, 'UNSET'],
  -Dir => [qw(NONE SEND_HEADER SETUP_ENV MERGE_HANDLERS UNSET)],
  +Dir => [qw(NONE SEND_HEADER SETUP_ENV MERGE_HANDLERS GLOBAL_REQUEST UNSET)],
  +Req => [qw(NONE SET_GLOBAL_REQUEST)],
   Interp => [qw(NONE IN_USE PUTBACK CLONED BASE)],
   Handler => [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC)],
   );
  @@ -521,7 +522,7 @@
   );
   
   my @c_src_names = qw(interp tipool log config cmd options callback handler
  - gtop util filter bucket mgv pcw);
  + gtop util filter bucket mgv pcw global);
   my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
   my @c_names   = ('mod_perl', (map "modperl_$_", @c_src_names));
   sub c_files { [map { "$_.c" } @c_names, @g_c_names] }
  
  
  

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

[dougm]

dougm   01/04/29 21:35:09

  Added:   src/modules/perl modperl_global.c modperl_global.h
  Log:
  module to manage globals and tls
  
  Revision  ChangesPath
  1.1  modperl-2.0/src/modules/perl/modperl_global.c
  
  Index: modperl_global.c
  ===
  #include "mod_perl.h"
  
  void modperl_global_request_cfg_set(request_rec *r)
  {
  MP_dDCFG;
  MP_dRCFG;
  
  /* only if PerlOptions +GlobalRequest and not done already */
  if (MpDirGLOBAL_REQUEST(dcfg) && !MpReqSET_GLOBAL_REQUEST(rcfg)) {
  modperl_global_request_set(r);
  MpReqSET_GLOBAL_REQUEST_On(rcfg);
  }
  }
  
  void modperl_global_request_set(request_rec *r)
  {
  MP_dRCFG;
  
  modperl_tls_set_request_rec(r);
  
  /* so 'PerlOptions +GlobalRequest' doesnt wipe us out */
  MpReqSET_GLOBAL_REQUEST_On(rcfg);
  
  if (r->main) {
  /* reset after subrequests */
  modperl_tls_reset_cleanup_request_rec(r->pool, r->main);
  }
  }
  
  void modperl_global_request_obj_set(pTHX_ SV *svr)
  {
  /* XXX: support sublassing */
  request_rec *r = modperl_sv2request_rec(aTHX_ svr);
  modperl_global_request_set(r);
  }
  
  #if MP_THREADED
  static apr_status_t modperl_global_cleanup(void *data)
  {
  modperl_global_t *global = (modperl_global_t *)data;
  
  MP_TRACE_g(MP_FUNC, "destroy lock for %s\n", global->name);
  MUTEX_DESTROY(&global->glock);
  
  return APR_SUCCESS;
  }
  #endif
  
  void modperl_global_init(modperl_global_t *global, apr_pool_t *p,
   void *data, const char *name)
  {
  Zero(global, 1, modperl_global_t);
  
  global->data = data;
  global->name = name;
  
  #if MP_THREADED
  MUTEX_INIT(&global->glock);
  
  apr_pool_cleanup_register(p, (void *)global,
modperl_global_cleanup,
apr_pool_cleanup_null);
  #endif
  
  MP_TRACE_g(MP_FUNC, "init %s\n", name);
  }
  
  void modperl_global_lock(modperl_global_t *global)
  {
  #if MP_THREADED
  MP_TRACE_g(MP_FUNC, "locking %s\n", global->name);
  MUTEX_LOCK(&global->glock);
  #endif
  }
  
  void modperl_global_unlock(modperl_global_t *global)
  {
  #if MP_THREADED
  MP_TRACE_g(MP_FUNC, "unlocking %s\n", global->name);
  MUTEX_UNLOCK(&global->glock);
  #endif
  }
  
  void *modperl_global_get(modperl_global_t *global)
  {
  return global->data;
  }
  
  void modperl_global_set(modperl_global_t *global, void *data)
  {
  global->data = data;
  }
  
  /* hopefully there wont be many of these */
  
  #define MP_GLOBAL_IMPL(gname, type)  \
   \
  static modperl_global_t MP_global_##gname;   \
   \
  void modperl_global_init_##gname(apr_pool_t *p,  \
   type gname) \
  {\
  modperl_global_init(&MP_global_##gname, p,   \
  (void *)gname, #gname);  \
  }\
   \
  void modperl_global_lock_##gname(void)   \
  {\
  modperl_global_lock(&MP_global_##gname); \
  }\
   \
  void modperl_global_unlock_##gname(void) \
  {\
  modperl_global_unlock(&MP_global_##gname);   \
  }\
   \
  type modperl_global_get_##gname(void)\
  {\
  return (type )   \
 modperl_global_get(&MP_global_##gname);   \
  }\
   \
  void modperl_global_set_##gname(void *data)  \
  {\
  modperl_global_set(&MP_global_##gname, data);\
  }\
  
  MP_GLOBAL_IMPL(pconf, apr_pool_t *);
  
  #if MP_THREADED
  static apr_status_t modperl_tls_cleanup(void *data)
  {
  return apr_threadkey_private_delete((apr_threadkey_t *)data);
  }
  #endif
  
  apr_status_t modperl_tls_create(apr_pool_t *p, modperl_tls_t **key)
  {
  #if MP_THREADED
  apr_status_t status = apr_threadkey_private_create(key, NULL, p);
  apr_pool_cleanup_register(p, (void *)*key,
  

cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm

[dougm]

dougm   01/04/29 10:53:42

  Modified:t/response/TestAPI uri.pm
   xs/Apache/URI Apache__URI.h
   xs/maps  apache_functions.map apache_structures.map
   xs/tables/current/ModPerl FunctionTable.pm
  Log:
  special case Apache::URI->port
  
  Revision  ChangesPath
  1.3   +14 -3 modperl-2.0/t/response/TestAPI/uri.pm
  
  Index: uri.pm
  ===
  RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/uri.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- uri.pm2001/04/28 22:42:06 1.2
  +++ uri.pm2001/04/29 17:53:41 1.3
  @@ -12,7 +12,7 @@
   sub handler {
   my $r = shift;
   
  -plan $r, tests => 12;
  +plan $r, tests => 14;
   
   $r->args('query');
   
  @@ -50,16 +50,27 @@
   
   ok $newr->args eq 'query';
   
  -ok $newr->parsed_uri->path eq $path;
  +my $puri = $newr->parsed_uri;
   
  -ok $newr->parsed_uri->query eq 'query';
  +ok $puri->path eq $path;
   
  +ok $puri->query eq 'query';
  +
   my @c = qw(one two three);
   $url_string = join '%20', @c;
   
   Apache::unescape_url($url_string);
   
   ok $url_string eq "@c";
  +
  +my $port = 6767;
  +$puri->port($port);
  +$puri->scheme('ftp');
  +$puri->hostname('perl.apache.org');
  +
  +ok $puri->port == $port;
  +
  +ok $puri->unparse eq "ftp://perl.apache.org:$port$path?query";;
   
   Apache::OK;
   }
  
  
  
  1.2   +17 -0 modperl-2.0/xs/Apache/URI/Apache__URI.h
  
  Index: Apache__URI.h
  ===
  RCS file: /home/cvs/modperl-2.0/xs/Apache/URI/Apache__URI.h,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- Apache__URI.h 2001/04/28 22:35:22 1.1
  +++ Apache__URI.h 2001/04/29 17:53:41 1.2
  @@ -74,3 +74,20 @@
   
   return status;
   }
  +
  +static MP_INLINE
  +char *mpxs_Apache__URI_port(uri_components *uri, SV *portsv)
  +{
  +dTHX; /*XXX*/
  +char *port_str = uri->port_str;
  +
  +if (portsv) {
  +STRLEN len;
  +char *port = SvPV(portsv, len);
  +uri->port_str = apr_pstrndup(((modperl_uri_t *)uri)->pool,
  + port, len);
  +uri->port = (int)SvIV(portsv);
  +}
  +
  +return port_str;
  +}
  
  
  
  1.16  +2 -0  modperl-2.0/xs/maps/apache_functions.map
  
  Index: apache_functions.map
  ===
  RCS file: /home/cvs/modperl-2.0/xs/maps/apache_functions.map,v
  retrieving revision 1.15
  retrieving revision 1.16
  diff -u -r1.15 -r1.16
  --- apache_functions.map  2001/04/28 22:35:23 1.15
  +++ apache_functions.map  2001/04/29 17:53:42 1.16
  @@ -250,6 +250,8 @@
SV *:classname, SV *:p, uri=NULL | parse
ap_unparse_uri_components | mpxs_ | \
uptr, flags=UNP_OMITPASSWORD | unparse
  + #special case to set both uri->port and uri->port_str
  + mpxs_Apache__URI_port | | uri, portsv=Nullsv
   PACKAGE=Apache::RequestRec
mpxs_Apache__RequestRec_parsed_uri
   
  
  
  
  1.6   +2 -2  modperl-2.0/xs/maps/apache_structures.map
  
  Index: apache_structures.map
  ===
  RCS file: /home/cvs/modperl-2.0/xs/maps/apache_structures.map,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- apache_structures.map 2001/04/18 16:52:49 1.5
  +++ apache_structures.map 2001/04/29 17:53:42 1.6
  @@ -223,12 +223,12 @@
  user
  password
  hostname
  -   port_str
  +-  port_str
  path
  query
  fragment
  hostent
  -   port
  +~  port
  is_initialized
  dns_looked_up
  dns_resolved
  
  
  
  1.12  +15 -1 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
  
  Index: FunctionTable.pm
  ===
  RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
  retrieving revision 1.11
  retrieving revision 1.12
  diff -u -r1.11 -r1.12
  --- FunctionTable.pm  2001/04/28 22:42:56 1.11
  +++ FunctionTable.pm  2001/04/29 17:53:42 1.12
  @@ -2,7 +2,7 @@
   
   # !!
   # ! WARNING: generated by ModPerl::ParseSource/0.01
  -# !  Sat Apr 28 15:36:08 2001
  +# !  Sun Apr 29 10:27:28 2001
   # !  do NOT edit, any changes will be lost !
   # !!
   
  @@ -2979,6 +2979,20 @@
 }
   ],
   'name' => 'mpxs_ap_unescape_url'
  +  },
  +  {
  +'return_type' => 'char *',
  +'args' => [
  +  {
  +'name' => 'uri',
  +'type' => 'uri_components *'
  +  },
  +  {
  +'name' => 'portsv',
  +