perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@hyperreal.org
Subject cvs commit: modperl/t/net/perl api.pl file.pl
Date Fri, 13 Nov 1998 21:39:02 GMT
dougm       98/11/13 13:39:02

  Modified:    .        Changes ToDo
               lib/Apache ExtUtils.pm
               src/modules/perl ModuleConfig.xs mod_perl.h perl_config.c
               t/TestDirectives TestDirectives.pm
               t/conf   httpd.conf-dist
               t/net/perl api.pl file.pl
  Log:
  SERVER_CREATE/SERVER_MERGE methods implemented for directive handlers
  
  Revision  Changes    Path
  1.196     +2 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /export/home/cvs/modperl/Changes,v
  retrieving revision 1.195
  retrieving revision 1.196
  diff -u -r1.195 -r1.196
  --- Changes	1998/11/13 03:27:47	1.195
  +++ Changes	1998/11/13 21:38:55	1.196
  @@ -8,6 +8,8 @@
   
   =item 1.16_01-dev
   
  +SERVER_CREATE/SERVER_MERGE methods implemented for directive handlers
  +
   new-ish xs modules added to win32 build: Apache::Log, Apache::File,
   Apache::Table, Apache::URI, Apache::Util
    
  
  
  
  1.114     +0 -2      modperl/ToDo
  
  Index: ToDo
  ===================================================================
  RCS file: /export/home/cvs/modperl/ToDo,v
  retrieving revision 1.113
  retrieving revision 1.114
  diff -u -r1.113 -r1.114
  --- ToDo	1998/11/13 03:27:48	1.113
  +++ ToDo	1998/11/13 21:38:56	1.114
  @@ -3,8 +3,6 @@
                    (well, close to it anyhow)
   ---------------------------------------------------------------------------
   
  -- SERVER_CREATE/SERVER_MERGE
  -
   - stronghold patches [Todd R. Eigenschink <todd@tekinteractive.com>]
   
   - Andrew Ford's Apache::FakeRequest patch
  
  
  
  1.13      +10 -1     modperl/lib/Apache/ExtUtils.pm
  
  Index: ExtUtils.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/lib/Apache/ExtUtils.pm,v
  retrieving revision 1.12
  retrieving revision 1.13
  diff -u -r1.12 -r1.13
  --- ExtUtils.pm	1998/09/16 00:05:15	1.12
  +++ ExtUtils.pm	1998/11/13 21:38:57	1.13
  @@ -131,6 +131,15 @@
       my $dir_merger = $class->can('DIR_MERGE') ?
   	"perl_perl_merge_dir_config" : "NULL";
   
  +    my $dir_create = $class->can('DIR_CREATE') ?
  +	"perl_perl_create_dir_config" : "NULL";
  +
  +    my $server_merger = $class->can('SERVER_MERGE') ?
  +	"perl_perl_merge_srv_config" : "NULL";
  +
  +    my $server_create = $class->can('SERVER_CREATE') ?
  +	"perl_perl_create_srv_config" : "NULL";
  +
       return <<EOF;
   #include "modules/perl/mod_perl.h"
   
  @@ -176,7 +185,7 @@
       create_dir_config_sv,  /* per-directory config creator */
       $dir_merger,   /* dir config merger */
       create_srv_config_sv,       /* server config creator */
  -    NULL,        /* server config merger */
  +    $server_merger,        /* server config merger */
       mod_cmds,               /* command table */
       NULL,           /* [7] list of handlers */
       NULL,  /* [2] filename-to-URI translation */
  
  
  
  1.6       +4 -6      modperl/src/modules/perl/ModuleConfig.xs
  
  Index: ModuleConfig.xs
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/ModuleConfig.xs,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- ModuleConfig.xs	1998/10/20 23:37:40	1.5
  +++ ModuleConfig.xs	1998/11/13 21:38:57	1.6
  @@ -96,21 +96,19 @@
           caller = svkey;
   
       if((svkey == Nullsv) || caller) {
  -	HV *xs_config = perl_get_hv("Apache::XS_ModuleConfig", TRUE);
  -	SV **mod_ptr = (SV**)NULL;
  +	module *mod = NULL;
   
   	if(!caller)
   	    caller = perl_eval_pv("scalar caller", TRUE);
   
   	if(caller) 
  -	    mod_ptr = hv_fetch(xs_config, SvPVX(caller), SvCUR(caller), FALSE);
  +	    mod = perl_get_module_ptr(SvPVX(caller), SvCUR(caller));
   
  -	if(mod_ptr && *mod_ptr) {
  -	    IV tmp = SvIV((SV*)SvRV(*mod_ptr));
  +	if(mod) {
   	    int type = 0;
   	    void *ptr = vector_from_sv(obj, &type);
   	    mod_perl_perl_dir_config *data = 
  -		get_module_config(ptr, (module *)tmp);
  +		get_module_config(ptr, mod);
   	    if(data->obj) {
   		++SvREFCNT(data->obj);
   		RETVAL = data->obj;
  
  
  
  1.59      +2 -0      modperl/src/modules/perl/mod_perl.h
  
  Index: mod_perl.h
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.h,v
  retrieving revision 1.58
  retrieving revision 1.59
  diff -u -r1.58 -r1.59
  --- mod_perl.h	1998/11/12 20:04:54	1.58
  +++ mod_perl.h	1998/11/13 21:38:58	1.59
  @@ -1076,6 +1076,7 @@
   
   char *mod_perl_auth_name(request_rec *r, char *val);
   
  +module *perl_get_module_ptr(char *name, int len);
   void *perl_merge_dir_config(pool *p, void *basev, void *addv);
   void *perl_create_dir_config(pool *p, char *dirname);
   void *perl_create_server_config(pool *p, server_rec *s);
  @@ -1139,6 +1140,7 @@
   #define perl_cmd_perl_TAKE23 perl_cmd_perl_TAKE123
   #define perl_cmd_perl_TAKE3 perl_cmd_perl_TAKE123
   void *perl_perl_merge_dir_config(pool *p, void *basev, void *addv);
  +void *perl_perl_merge_srv_config(pool *p, void *basev, void *addv);
   
   void mod_perl_dir_env(perl_dir_config *cld);
   void mod_perl_pass_env(pool *p, perl_server_config *cls);
  
  
  
  1.45      +47 -8     modperl/src/modules/perl/perl_config.c
  
  Index: perl_config.c
  ===================================================================
  RCS file: /export/home/cvs/modperl/src/modules/perl/perl_config.c,v
  retrieving revision 1.44
  retrieving revision 1.45
  diff -u -r1.44 -r1.45
  --- perl_config.c	1998/11/13 03:27:52	1.44
  +++ perl_config.c	1998/11/13 21:38:58	1.45
  @@ -721,15 +721,26 @@
       return sv;
   }
   
  -static SV *perl_perl_create_dir_config(SV **sv, HV *class, cmd_parms *parms)
  +module *perl_get_module_ptr(char *name, int len)
  +{
  +    HV *xs_config = perl_get_hv("Apache::XS_ModuleConfig", TRUE);
  +    SV **mod_ptr = hv_fetch(xs_config, name, len, FALSE);
  +    if(mod_ptr && *mod_ptr)
  +	return (module *)SvIV((SV*)SvRV(*mod_ptr));
  +    else
  +	return NULL;
  +}
  +
  +static SV *
  +perl_perl_create_cfg(SV **sv, HV *class, cmd_parms *parms, char *type)
   {
       GV *gv;
   
       if(*sv && SvTRUE(*sv) && SvROK(*sv) && sv_isobject(*sv))
   	return *sv;
   
  -    /* return $class->DIR_CREATE if $class->can("DIR_CREATE") */
  -    if((gv = gv_fetchmethod_autoload(class, PERL_DIR_CREATE, FALSE)) && isGV(gv))
{
  +    /* return $class->type if $class->can(type) */
  +    if((gv = gv_fetchmethod_autoload(class, type, FALSE)) && isGV(gv)) {
   	int count;
   	dSP;
   
  @@ -761,7 +772,17 @@
       }
   }
   
  -void *perl_perl_merge_dir_config(pool *p, void *basev, void *addv)
  +static SV *perl_perl_create_dir_config(SV **sv, HV *class, cmd_parms *parms)
  +{
  +    return perl_perl_create_cfg(sv, class, parms, PERL_DIR_CREATE);
  +}
  +
  +static SV *perl_perl_create_srv_config(SV **sv, HV *class, cmd_parms *parms)
  +{
  +    return perl_perl_create_cfg(sv, class, parms, PERL_SERVER_CREATE);
  +}
  +
  +static void *perl_perl_merge_cfg(pool *p, void *basev, void *addv, char *meth)
   {
       GV *gv;
       mod_perl_perl_dir_config *new = NULL,
  @@ -777,16 +798,16 @@
   	return basesv;
   
       MP_TRACE_c(fprintf(stderr, "looking for method %s in package `%s'\n", 
  -		       PERL_DIR_MERGE, SvCLASS(basesv)));
  +		       meth, SvCLASS(basesv)));
   
  -    if((gv = gv_fetchmethod_autoload(SvSTASH(SvRV(basesv)), PERL_DIR_MERGE, FALSE)) &&
isGV(gv)) {
  +    if((gv = gv_fetchmethod_autoload(SvSTASH(SvRV(basesv)), meth, FALSE)) && isGV(gv))
{
   	int count;
   	dSP;
   	new = (mod_perl_perl_dir_config *)
   	    palloc(p, sizeof(mod_perl_perl_dir_config));
   
   	MP_TRACE_c(fprintf(stderr, "calling %s->%s\n", 
  -			   SvCLASS(basesv), PERL_DIR_MERGE));
  +			   SvCLASS(basesv), meth));
   
   	ENTER;SAVETMPS;
   	PUSHMARK(sp);
  @@ -810,6 +831,16 @@
       return (void *)new;
   }
   
  +void *perl_perl_merge_dir_config(pool *p, void *basev, void *addv)
  +{
  +    return perl_perl_merge_cfg(p, basev, addv, PERL_DIR_MERGE);
  +}
  +
  +void *perl_perl_merge_srv_config(pool *p, void *basev, void *addv)
  +{
  +    return perl_perl_merge_cfg(p, basev, addv, PERL_SERVER_MERGE);
  +}
  +
   void perl_perl_cmd_cleanup(void *data)
   {
       mod_perl_perl_dir_config *cld = (mod_perl_perl_dir_config *)data;
  @@ -832,8 +863,16 @@
       CV *cv = perl_get_cv(subname, TRUE);
       SV *obj;
       bool has_empty_proto = (SvPOK(cv) && (SvLEN(cv) == 1));
  -
  +    module *xsmod = perl_get_module_ptr(data->class, strlen(data->class));
  +    mod_perl_perl_dir_config *sdata = NULL;
       obj = perl_perl_create_dir_config(&data->obj, CvSTASH(cv), cmd);
  +
  +    if(xsmod && 
  +       (sdata = get_module_config(cmd->server->module_config, xsmod))) {
  +	void *sobj = 
  +	    perl_perl_create_srv_config(&sdata->obj, CvSTASH(cv), cmd);
  +	set_module_config(cmd->server->module_config, xsmod, sdata);
  +    }
   
       ENTER;SAVETMPS;
       PUSHMARK(sp);
  
  
  
  1.11      +10 -0     modperl/t/TestDirectives/TestDirectives.pm
  
  Index: TestDirectives.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/TestDirectives/TestDirectives.pm,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -r1.10 -r1.11
  --- TestDirectives.pm	1998/09/16 00:33:13	1.10
  +++ TestDirectives.pm	1998/11/13 21:39:00	1.11
  @@ -113,5 +113,15 @@
       return bless \%new, ref($base);
   }
   
  +*SERVER_MERGE = \&DIR_MERGE;
  +
  +sub SERVER_CREATE {
  +    my($class, $parms) = @_;
  +    warn "$class->SERVER_CREATE\n";
  +    return bless {
  +	ServerClass => __PACKAGE__,
  +    }, $class;
  +}
  + 
   1;
   __END__
  
  
  
  1.18      +8 -0      modperl/t/conf/httpd.conf-dist
  
  Index: httpd.conf-dist
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/conf/httpd.conf-dist,v
  retrieving revision 1.17
  retrieving revision 1.18
  diff -u -r1.17 -r1.18
  --- httpd.conf-dist	1998/11/05 04:45:39	1.17
  +++ httpd.conf-dist	1998/11/13 21:39:01	1.18
  @@ -43,6 +43,14 @@
   PerlRequire docs/startup.pl
   PerlRequire docs/stacked.pl
   
  +=pod
  +<Perl>
  +    push @INC, map { "t/TestDirectives/blib/$_" } qw(arch lib);
  +    require Apache::TestDirectives;
  +</Perl>
  +TestCmd one two
  +=cut
  +
   #we do this to test that `PerlSendHeader Off' will work
   <Files ~ "\.pl$">
      PerlHandler          Apache::Registry
  
  
  
  1.31      +10 -2     modperl/t/net/perl/api.pl
  
  Index: api.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/api.pl,v
  retrieving revision 1.30
  retrieving revision 1.31
  diff -u -r1.30 -r1.31
  --- api.pl	1998/09/16 16:27:03	1.30
  +++ api.pl	1998/11/13 21:39:01	1.31
  @@ -21,7 +21,7 @@
   $tests += 2 unless $is_win32;
   my $test_get_set = Apache->can('set_handlers') && ($tests += 4);
   my $test_custom_response = (MODULE_MAGIC_NUMBER >= 19980324) && $tests++;
  -my $test_dir_config = $INC{'Apache/TestDirectives.pm'} && ($tests += 7);
  +my $test_dir_config = $INC{'Apache/TestDirectives.pm'} && ($tests += 9);
   
   my $i;
   
  @@ -178,10 +178,19 @@
   }
   
   if($test_dir_config) {
  +    require Data::Dumper;
       require Apache::ModuleConfig;
       my $dc = Apache::ModuleConfig->get($r);
       test ++$i, not $dc;
   
  +    {
  +	package Apache::TestDirectives;
  +	use Apache::test 'test';
  +	my $scfg = Apache::ModuleConfig->get($r->server);
  +	test ++$i, $scfg;
  +	test ++$i,  __PACKAGE__->isa($scfg->{ServerClass});
  +	print Data::Dumper::Dumper($scfg);
  +    }
       for my $cv (
   		sub {
   		    package Apache::TestDirectives;
  @@ -192,7 +201,6 @@
   		})
       {
           my $cfg = $cv->();
  -        require Data::Dumper;
           $r->print(Data::Dumper::Dumper($cfg));
           test ++$i, "$cfg" =~ /HASH/;
           test ++$i, keys(%$cfg) >= 3;
  
  
  
  1.3       +2 -1      modperl/t/net/perl/file.pl
  
  Index: file.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/file.pl,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- file.pl	1998/11/08 01:15:19	1.2
  +++ file.pl	1998/11/13 21:39:02	1.3
  @@ -1,4 +1,4 @@
  -
  +use strict;
   use Apache::test;
   
   my $r = shift;
  @@ -12,6 +12,7 @@
   require Apache::File;
   print "1..5\n";
   my $fh = Apache::File->new;
  +my $i = 0;
   test ++$i, $fh;
   test ++$i, $fh->open($0);
   test ++$i, !$fh->open("$0.nochance");
  
  
  

Mime
View raw message