You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1998/11/13 22:39:02 UTC
cvs commit: modperl/t/net/perl api.pl file.pl
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 <to...@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");