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/07/08 20:07:53 UTC
cvs commit: modperl/t/net/perl api.pl constants.pl
dougm 98/07/08 11:07:53
Modified: . Changes
Constants Constants.pm
ModuleConfig ModuleConfig.pm
lib/Apache ExtUtils.pm
src/modules/perl Constants.xs mod_perl.c mod_perl.h
perl_config.c
t/TestDirectives TestDirectives.pm
t/net/perl api.pl constants.pl
Log:
add dir_merge support for directive handlers
Revision Changes Path
1.64 +2 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /export/home/cvs/modperl/Changes,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -r1.63 -r1.64
--- Changes 1998/07/08 18:05:37 1.63
+++ Changes 1998/07/08 18:07:46 1.64
@@ -8,6 +8,8 @@
=item 1.12_01-dev
+add dir_merge support for directive handlers
+
$r->print/print will dereference \$scalar refs to strings so scripts
can avoid string copies when sending data to the client,
e.g. print \$large_string
1.7 +3 -1 modperl/Constants/Constants.pm
Index: Constants.pm
===================================================================
RCS file: /export/home/cvs/modperl/Constants/Constants.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- Constants.pm 1998/05/10 04:14:51 1.6
+++ Constants.pm 1998/07/08 18:07:47 1.7
@@ -48,6 +48,7 @@
HTTP_SERVICE_UNAVAILABLE
HTTP_VARIANT_ALSO_VARIES);
my(@config) = qw(DECLINE_CMD);
+my(@types) = qw(DIR_MAGIC_TYPE);
my $rc = [@common, @response];
@@ -61,6 +62,7 @@
remotehost => \@remotehost,
satisfy => \@satisfy,
server => \@server,
+ types => \@types,
#depreciated
response_codes => $rc,
);
@@ -74,6 +76,7 @@
@satisfy,
@server,
@config,
+ @types,
);
*Apache::Constants::EXPORT = \@common;
@@ -231,7 +234,6 @@
MODULE_MAGIC_NUMBER
SERVER_VERSION
- SERVER_SUBVERSION
=back
1.2 +16 -0 modperl/ModuleConfig/ModuleConfig.pm
Index: ModuleConfig.pm
===================================================================
RCS file: /export/home/cvs/modperl/ModuleConfig/ModuleConfig.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- ModuleConfig.pm 1998/05/10 04:05:06 1.1
+++ ModuleConfig.pm 1998/07/08 18:07:48 1.2
@@ -11,6 +11,22 @@
__PACKAGE__->bootstrap;
}
+sub has_srv_config {
+ my $file = (caller)[1];
+ if($Apache::ServerStarting == 1) {
+ delete $INC{$file};
+ }
+}
+
+sub dir_merge {
+ my($base, $add) = @_;
+ my %new = ();
+ @new{ keys %$base, keys %$add} =
+ (values %$base, values %$add);
+
+ return bless \%new, ref($base);
+}
+
1;
__END__
1.10 +7 -4 modperl/lib/Apache/ExtUtils.pm
Index: ExtUtils.pm
===================================================================
RCS file: /export/home/cvs/modperl/lib/Apache/ExtUtils.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- ExtUtils.pm 1998/05/14 03:06:55 1.9
+++ ExtUtils.pm 1998/07/08 18:07:49 1.10
@@ -28,7 +28,7 @@
require lib;
my $lib = "lib";#hmm, lib->import + -w == Unquoted string "lib" ...
$lib->import('./lib');
- require $class;
+ eval { require $class };
}
unless (-e "$file.xs.orig") {
File::Copy::cp("$file.xs", "$file.xs.orig");
@@ -85,8 +85,8 @@
}
elsif(ref($cmd) eq "HASH") {
$name = $cmd->{name};
- $sub = $cmd->{func};
- $sub = join '::', $class, $cmd->{func} unless defined &$sub;
+ $sub = $cmd->{func} || $cmd->{name};
+ $sub = join '::', $class, $sub unless defined &$sub;
$cmd_data = $cmd->{cmd_data};
$req_override = $cmd->{req_override};
$desc = $cmd->{errmsg};
@@ -127,6 +127,9 @@
EOF
}
+ my $dir_merger = $class->can('dir_merge') ?
+ "perl_perl_merge_dir_config" : "NULL";
+
return <<EOF;
#include "modules/perl/mod_perl.h"
@@ -169,7 +172,7 @@
STANDARD_MODULE_STUFF,
NULL, /* module initializer */
create_dir_config_sv, /* per-directory config creator */
- NULL, /* dir config merger */
+ $dir_merger, /* dir config merger */
create_srv_config_sv, /* server config creator */
NULL, /* server config merger */
mod_cmds, /* command table */
1.8 +9 -0 modperl/src/modules/perl/Constants.xs
Index: Constants.xs
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/Constants.xs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Constants.xs 1998/06/03 17:05:31 1.7
+++ Constants.xs 1998/07/08 18:07:49 1.8
@@ -846,3 +846,12 @@
#endif
OUTPUT:
RETVAL
+
+char *
+DIR_MAGIC_TYPE()
+
+ CODE:
+ RETVAL = DIR_MAGIC_TYPE;
+
+ OUTPUT:
+ RETVAL
1.27 +1 -1 modperl/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /export/home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- mod_perl.c 1998/06/26 00:11:46 1.26
+++ mod_perl.c 1998/07/08 18:07:49 1.27
@@ -410,7 +410,7 @@
mp_debug = 0xffffffff;
}
else if (isALPHA(dstr[0])) {
- static char debopts[] = "dshg";
+ static char debopts[] = "dshgc";
char *d;
for (; *dstr && (d = strchr(debopts,*dstr)); dstr++)
1.29 +10 -5 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.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- mod_perl.h 1998/07/07 16:19:52 1.28
+++ mod_perl.h 1998/07/08 18:07:50 1.29
@@ -133,6 +133,8 @@
typedef cmd_parms * Apache__CmdParms;
typedef table * Apache__Table;
+#define SvCLASS(o) HvNAME(SvSTASH(SvRV(o)))
+
#define GvHV_init(name) gv_fetchpv(name, GV_ADDMULTI, SVt_PVHV)
#define GvSV_init(name) gv_fetchpv(name, GV_ADDMULTI, SVt_PV)
@@ -187,17 +189,19 @@
extern U32 mp_debug;
#ifdef PERL_TRACE
-#define MP_TRACE(a) if (mp_debug) a
-#define MP_TRACE_d(a) if (mp_debug & 1) a /* directives */
-#define MP_TRACE_s(a) if (mp_debug & 2) a /* perl sections */
-#define MP_TRACE_h(a) if (mp_debug & 4) a /* handlers */
-#define MP_TRACE_g(a) if (mp_debug & 8) a /* globals and allocation */
+#define MP_TRACE(a) if (mp_debug) a
+#define MP_TRACE_d(a) if (mp_debug & 1) a /* directives */
+#define MP_TRACE_s(a) if (mp_debug & 2) a /* perl sections */
+#define MP_TRACE_h(a) if (mp_debug & 4) a /* handlers */
+#define MP_TRACE_g(a) if (mp_debug & 8) a /* globals and allocation */
+#define MP_TRACE_c(a) if (mp_debug & 16) a /* directive handlers */
#else
#define MP_TRACE(a)
#define MP_TRACE_d(a)
#define MP_TRACE_s(a)
#define MP_TRACE_h(a)
#define MP_TRACE_g(a)
+#define MP_TRACE_c(a)
#endif
/* cut down on some noise in source */
@@ -995,6 +999,7 @@
#define perl_cmd_perl_TAKE12 perl_cmd_perl_TAKE2
#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 mod_perl_dir_env(perl_dir_config *cld);
void mod_perl_pass_env(pool *p, perl_server_config *cls);
1.22 +49 -2 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.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- perl_config.c 1998/07/02 14:53:52 1.21
+++ perl_config.c 1998/07/08 18:07:50 1.22
@@ -650,11 +650,12 @@
ENTER;SAVETMPS;
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVpv(HvNAME(class),0)));
- XPUSHs(perl_bless_cmd_parms(parms));
+ if(parms)
+ XPUSHs(perl_bless_cmd_parms(parms));
PUTBACK;
count = perl_call_sv((SV*)GvCV(gv), G_EVAL | G_SCALAR);
SPAGAIN;
- if((perl_eval_ok(parms->server) == OK) && (count == 1)) {
+ if((perl_eval_ok(parms ? parms->server : NULL) == OK) && (count == 1)) {
*sv = POPs;
++SvREFCNT(*sv);
}
@@ -671,6 +672,52 @@
else
return *sv;
}
+}
+
+#define DIR_MERGE "dir_merge"
+
+void *perl_perl_merge_dir_config(pool *p, void *basev, void *addv)
+{
+ GV *gv;
+ mod_perl_perl_dir_config *new,
+ *basevp = (mod_perl_perl_dir_config *)basev,
+ *addvp = (mod_perl_perl_dir_config *)addv;
+ SV *sv, *basesv = basevp->obj, *addsv = addvp->obj;
+
+ if(!sv_isobject(basesv))
+ return basesv;
+
+ MP_TRACE_c(fprintf(stderr, "looking for method %s in package `%s'\n",
+ DIR_MERGE, SvCLASS(basesv)));
+
+ if((gv = gv_fetchmethod_autoload(SvSTASH(SvRV(basesv)), DIR_MERGE, 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), DIR_MERGE));
+
+ ENTER;SAVETMPS;
+ PUSHMARK(sp);
+ XPUSHs(basesv);XPUSHs(addsv);
+ PUTBACK;
+ count = perl_call_sv((SV*)GvCV(gv), G_EVAL | G_SCALAR);
+ SPAGAIN;
+ if((perl_eval_ok(NULL) == OK) && (count == 1)) {
+ sv = POPs;
+ ++SvREFCNT(sv);
+ new->obj = sv;
+ new->class = SvCLASS(sv);
+ }
+ FREETMPS;LEAVE;
+ }
+ else {
+ new->obj = newSVsv(basesv);
+ new->class = basevp->class;
+ }
+ return (void *)new;
}
CHAR_P perl_cmd_perl_TAKE123(cmd_parms *cmd, mod_perl_perl_dir_config *data,
1.9 +9 -0 modperl/t/TestDirectives/TestDirectives.pm
Index: TestDirectives.pm
===================================================================
RCS file: /export/home/cvs/modperl/t/TestDirectives/TestDirectives.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- TestDirectives.pm 1998/05/14 03:06:59 1.8
+++ TestDirectives.pm 1998/07/08 18:07:51 1.9
@@ -104,6 +104,15 @@
}, $class;
}
+sub dir_merge {
+ my($base, $add) = @_;
+ my %new = ();
+ @new{ keys %$base, keys %$add} =
+ (values %$base, values %$add);
+
+ return bless \%new, ref($base);
+}
+
# Preloaded methods go here.
# Autoload methods go after =cut, and are processed by the autosplit program.
1.22 +5 -1 modperl/t/net/perl/api.pl
Index: api.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/api.pl,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- api.pl 1998/06/26 00:11:47 1.21
+++ api.pl 1998/07/08 18:07:52 1.22
@@ -16,7 +16,7 @@
%ENV = $r->cgi_env;
$r->subprocess_env; #test void context
-my $tests = 45;
+my $tests = 46;
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);
@@ -114,6 +114,10 @@
test ++$i, $s->server_admin;
test ++$i, $s->server_hostname;
test ++$i, $s->port;
+
+++$i;
+my $s = "ok $i\n";
+$r->print(\$s);
test ++$i, $r->module("Apache");
test ++$i, not Apache->module("Not::A::Chance");
1.6 +1 -1 modperl/t/net/perl/constants.pl
Index: constants.pl
===================================================================
RCS file: /export/home/cvs/modperl/t/net/perl/constants.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- constants.pl 1998/05/19 23:21:19 1.5
+++ constants.pl 1998/07/08 18:07:52 1.6
@@ -28,7 +28,7 @@
push @export, grep {!$SEEN{$_}++} @Apache::Constants::EXPORT;
#skip some 1.3 stuff that 1.2 didn't have
-my %skip = map { $_,1 } qw(DONE REMOTE_DOUBLE_REV DECLINE_CMD
+my %skip = map { $_,1 } qw(DONE REMOTE_DOUBLE_REV DECLINE_CMD DIR_MAGIC_TYPE
SERVER_VERSION SERVER_SUBVERSION SERVER_BUILT);
my $tests = (1 + @export) - keys %skip;