cvs commit: modperl-2.0/t/conf - New directory
dougm 01/04/02 02:03:25 modperl-2.0/t/conf - New directory
cvs commit: modperl-2.0/t/response/TestAPR - New directory
dougm 01/04/02 02:03:57 modperl-2.0/t/response/TestAPR - New directory
cvs commit: modperl-2.0/t/response/TestApache - New directory
dougm 01/04/02 02:03:59 modperl-2.0/t/response/TestApache - New directory
cvs commit: modperl-2.0/t/response/TestApache post.pm
dougm 01/04/02 02:06:07
Added: t/response/TestApache post.pm
Log:
start of extended apache test
Revision ChangesPath
1.1 modperl-2.0/t/response/TestApache/post.pm
Index: post.pm
===
package TestApache::post;
use strict;
use warnings FATAL = 'all';
use APR::Table ();
sub read_post {
my $r = shift;
$r-setup_client_block;
return undef unless $r-should_client_block;
my $len = $r-headers_in-get('content-length');
my $buf;
$r-get_client_block($buf, $len);
return $buf;
}
sub handler {
my $r = shift;
$r-content_type('text/plain');
my $data = read_post($r) || "";
$r-puts(join ':', length($data), $data);
0;
}
1;
cvs commit: modperl-2.0/t/hooks/TestHooks - New directory
dougm 01/04/02 02:09:04 modperl-2.0/t/hooks/TestHooks - New directory
cvs commit: modperl-2.0/t/hooks/TestHooks authen.pm
dougm 01/04/02 02:09:40
Added: t/hooks authen.t
t/hooks/TestHooks authen.pm
Log:
start of hooks tests
Revision ChangesPath
1.1 modperl-2.0/t/hooks/authen.t
Index: authen.t
===
use strict;
use warnings FATAL = 'all';
use Test;
use Apache::TestRequest;
plan tests = 3;
my $location = "/TestHooks::authen";
ok ! GET_OK $location;
my $rc = GET_RC $location;
ok $rc == 401;
ok GET_OK $location, username = 'dougm', password = 'foo';
1.1 modperl-2.0/t/hooks/TestHooks/authen.pm
Index: authen.pm
===
package TestHooks::authen;
use strict;
use warnings FATAL = 'all';
use Apache::Access ();
sub handler {
my $r = shift;
#auth api not complete yet
0;
}
1;
__DATA__
require valid-user
AuthType Basic
AuthName simple
PerlResponseHandler Apache::TestHandler::ok1
SetHandler modperl
cvs commit: modperl-2.0/t TEST.PL
dougm 01/04/02 02:11:18
Added: tTEST.PL
Log:
the TEST template
Revision ChangesPath
1.1 modperl-2.0/t/TEST.PL
Index: TEST.PL
===
#!perl
use strict;
use warnings FATAL = 'all';
use lib map { "$_/Apache-Test/lib" } qw(. ..);
use Apache::TestRun ();
Apache::TestRun-new-run(@ARGV);
cvs commit: modperl-2.0 Makefile.PL
dougm 01/04/02 02:17:41
Modified:.Makefile.PL
Log:
hook into test stuff
Revision ChangesPath
1.30 +23 -1 modperl-2.0/Makefile.PL
Index: Makefile.PL
===
RCS file: /home/cvs/modperl-2.0/Makefile.PL,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- Makefile.PL 2001/03/27 02:32:49 1.29
+++ Makefile.PL 2001/04/02 09:17:40 1.30
@@ -3,15 +3,20 @@
use warnings FATAL = 'all';
use lib qw(lib);
+use Config;
use Apache::Build ();
use ModPerl::Code ();
use ModPerl::MM ();
+use lib qw(Apache-Test/lib);
+use Apache::TestMM qw(test);
+
our $VERSION;
my $build = Apache::Build-new(init = 1);
my $code = ModPerl::Code-new;
+my @scripts = qw(t/TEST);
configure();
ModPerl::MM::WriteMakefile(
@@ -58,6 +63,10 @@
#ModPerl::MM will use Apache::BuildConfig in subdir/Makefile.PL's
$build-save;
+for (@scripts) {
+generate_script($_);
+}
+
generate_xs($httpd_version) if $build-{MP_GENERATE_XS};
}
@@ -103,6 +112,19 @@
shift @INC;
}
+sub generate_script {
+my $file = shift;
+open my $in, "$file.PL" or die "Couldn't open $file.PL: $!";
+open my $out, '', $file or die "Couldn't open $file: $!";
+print "generating script...$file\n";
+print $out "#!$Config{perlpath}\n",
+ "# WARNING: this file is generated, edit $file.PL instead\n",
+ join '', $in;
+close $out or die "close $file: $!";
+close $in;
+chmod 0544, $file;
+}
+
sub echo_cmd {
my $cmd = shift;
print "$cmd\n";
@@ -112,7 +134,7 @@
sub clean_files {
my $path = $code-path;
-return [@{ $build-clean_files },
+return [@{ $build-clean_files }, @scripts,
map { "$path/$_"} @{ $code-clean_files }];
}
cvs commit: modperl-2.0/t/filter/TestFilter - New directory
dougm 01/04/02 11:16:33 modperl-2.0/t/filter/TestFilter - New directory
cvs commit: modperl-2.0/t/filter reverse.t
dougm 01/04/02 11:36:31
Modified:Apache-Test/lib/Apache TestConfig.pm TestConfigPerl.pm
TestServer.pm
Added: t/filter reverse.t
Log:
put a warning inside files that are generated
Revision ChangesPath
1.2 +17 -5 modperl-2.0/Apache-Test/lib/Apache/TestConfig.pm
Index: TestConfig.pm
===
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TestConfig.pm 2001/04/02 08:58:08 1.1
+++ TestConfig.pm 2001/04/02 18:36:23 1.2
@@ -364,13 +364,25 @@
}
#generate files and directories
+
+sub genwarning {
+my($self, $type) = @_;
+return unless $type;
+return "#WARNING: this file is generated, do not edit\n";
+}
+
sub genfile {
-my($self, $file) = @_;
+my($self, $file, $warn) = @_;
my $name = abs2rel $file, $self-{vars}-{t_dir};
$self-trace("generating $name");
open my $fh, '', $file or die "open $file: $!";
+
+if (my $msg = $self-genwarning($warn)) {
+print $fh $msg, "\n";
+}
+
$self-{clean}-{files}-{$file} = 1;
return $fh;
@@ -450,7 +462,7 @@
unless ($self-{inherit_config}-{TypesConfig}) {
my $types = catfile $self-{vars}-{t_conf}, 'mime.types';
unless (-e $types) {
-my $fh = $self-genfile($types);
+my $fh = $self-genfile($types, 1);
print $fh $self-types_config_template;
close $fh;
}
@@ -478,7 +490,7 @@
my $extra_conf_in = join '.', $extra_conf, 'in';
open(my $in, $extra_conf_in) or return;
-my $out = $self-genfile($extra_conf);
+my $out = $self-genfile($extra_conf, 1);
$self-replace_vars($in, $out);
close $in;
@@ -507,7 +519,7 @@
my $in = $self-httpd_conf_template($conf_file_in);
-my $out = $self-genfile($conf_file);
+my $out = $self-genfile($conf_file, 1);
$self-preamble_run($out);
@@ -610,7 +622,7 @@
my $name = 'apache_test_config';
my $file = catfile $self-{vars}-{t_conf}, "$name.pm";
-my $fh = $self-genfile($file);
+my $fh = $self-genfile($file, 1);
$self-trace("saving config data to $name.pm");
1.2 +3 -3 modperl-2.0/Apache-Test/lib/Apache/TestConfigPerl.pm
Index: TestConfigPerl.pm
===
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestConfigPerl.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TestConfigPerl.pm 2001/04/02 08:57:34 1.1
+++ TestConfigPerl.pm 2001/04/02 18:36:24 1.2
@@ -61,7 +61,7 @@
return if -e $t;
$self-gendir($dir);
-my $fh = $self-genfile($t);
+my $fh = $self-genfile($t, 1);
print $fh EOF;
use Apache::TestConfig ();
@@ -93,7 +93,7 @@
#but this will work for both 2.0 and 1.xx
if (my $inc = $self-{inc}) {
my $include_pl = catfile $self-{vars}-{t_conf}, 'modperl_inc.pl';
-my $fh = $self-genfile($include_pl);
+my $fh = $self-genfile($include_pl, 1);
for (@$inc) {
print $fh "use lib '$_';\n";
}
@@ -107,7 +107,7 @@
my $startup_pl = catfile $self-{vars}-{t_conf}, 'modperl_startup.pl';
unless (-e $startup_pl) {
-my $fh = $self-genfile($startup_pl);
+my $fh = $self-genfile($startup_pl, 1);
print $fh $self-startup_pl_code;
close $fh;
}
1.2 +1 -1 modperl-2.0/Apache-Test/lib/Apache/TestServer.pm
Index: TestServer.pm
===
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TestServer.pm 2001/04/02 08:58:38 1.1
+++ TestServer.pm 2001/04/02 18:36:25 1.2
@@ -78,7 +78,7 @@
my $one_process = $self-version_of(\%one_process);
my $file = catfile $config-{vars}-{serverroot}, '.gdb-test-start';
-my $fh = $config-genfile($file);
+my $fh = $config-genfile($file, 1);
print $fh "run $one_process $args";
close $fh;
1.1 modperl-2.0/t/filter/reverse.t
Index: reverse.t
===
#WARNING: this file is generated, do not edit
use Apache::TestConfig ();
print Apache::TestConfig-thaw-http_raw_get("/TestFilter::reverse");
cvs commit: modperl-2.0/t/filter .cvsignore reverse.t
dougm 01/04/02 11:55:00 Added: t/filter .cvsignore Removed: t/filter reverse.t Log: whoops Revision ChangesPath 1.1 modperl-2.0/t/filter/.cvsignore Index: .cvsignore === reverse.t
cvs commit: modperl-2.0/xs/Apache/Access - New directory
dougm 01/04/02 12:25:23 modperl-2.0/xs/Apache/Access - New directory
cvs commit: modperl-2.0/xs/maps apache_functions.map
dougm 01/04/02 12:30:40
Modified:t/hooks authen.t
t/hooks/TestHooks authen.pm
xs modperl_xs_util.h
xs/maps apache_functions.map
Added: xs/Apache/Access Apache__Access.h
Log:
add get_basic_auth_pw() wrapper and tests
Revision ChangesPath
1.2 +3 -1 modperl-2.0/t/hooks/authen.t
Index: authen.t
===
RCS file: /home/cvs/modperl-2.0/t/hooks/authen.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- authen.t 2001/04/02 09:09:40 1.1
+++ authen.t 2001/04/02 19:30:22 1.2
@@ -4,7 +4,7 @@
use Test;
use Apache::TestRequest;
-plan tests = 3;
+plan tests = 4;
my $location = "/TestHooks::authen";
@@ -15,5 +15,7 @@
ok $rc == 401;
ok GET_OK $location, username = 'dougm', password = 'foo';
+
+ok ! GET_OK $location, username = 'dougm', password = 'wrong';
1.2 +12 -1 modperl-2.0/t/hooks/TestHooks/authen.pm
Index: authen.pm
===
RCS file: /home/cvs/modperl-2.0/t/hooks/TestHooks/authen.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- authen.pm 2001/04/02 09:09:40 1.1
+++ authen.pm 2001/04/02 19:30:27 1.2
@@ -7,7 +7,18 @@
sub handler {
my $r = shift;
-#auth api not complete yet
+
+my($rc, $sent_pw) = $r-get_basic_auth_pw;
+
+return $rc if $rc != 0;
+
+my $user = $r-user;
+
+unless ($user eq 'dougm' and $sent_pw eq 'foo') {
+$r-note_basic_auth_failure;
+return 401;
+}
+
0;
}
1.4 +9 -0 modperl-2.0/xs/modperl_xs_util.h
Index: modperl_xs_util.h
===
RCS file: /home/cvs/modperl-2.0/xs/modperl_xs_util.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_xs_util.h 2001/03/13 06:49:12 1.3
+++ modperl_xs_util.h 2001/04/02 19:30:31 1.4
@@ -9,6 +9,15 @@
#define dITEMS I32 items = SP - MARK
#endif
+#define mpxs_PPCODE(code) STMT_START { \
+SP -= items; \
+code; \
+PUTBACK; \
+} STMT_END
+
+#define PUSHs_mortal_iv(iv) PUSHs(sv_2mortal(newSViv(iv)))
+#define PUSHs_mortal_pv(pv) PUSHs(sv_2mortal(newSVpv((char *)pv,0)))
+
#define mpxs_sv_grow(sv, len) \
(void)SvUPGRADE(sv, SVt_PV); \
SvGROW(sv, len+1)
1.1 modperl-2.0/xs/Apache/Access/Apache__Access.h
Index: Apache__Access.h
===
static XS(MPXS_ap_get_basic_auth_pw)
{
dXSARGS;
request_rec *r;
const char *sent_pw = NULL;
int rc;
mpxs_usage_items_1("r");
mpxs_PPCODE({
r = mp_xs_sv2_r(ST(0));
rc = ap_get_basic_auth_pw(r, sent_pw);
EXTEND(SP, 2);
PUSHs_mortal_iv(rc);
if (rc == OK) {
PUSHs_mortal_pv(sent_pw);
}
else {
PUSHs(PL_sv_undef);
}
});
}
1.8 +1 -1 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- apache_functions.map 2001/03/25 22:32:11 1.7
+++ apache_functions.map 2001/04/02 19:30:37 1.8
@@ -106,7 +106,7 @@
#MODULE=Apache::Auth
ap_auth_name
ap_auth_type
- ap_get_basic_auth_pw
+ ap_get_basic_auth_pw | MPXS_ | r
ap_note_auth_failure
ap_note_basic_auth_failure
ap_note_digest_auth_failure
cvs commit: modperl-2.0/Apache-Test/lib/Apache TestConfig.pm TestConfigPerl.pm
dougm 01/04/02 17:27:02
Modified:Apache-Test/lib/Apache TestConfig.pm TestConfigPerl.pm
Log:
shift certain .pm __DATA__ config directives outside its container, e.g. Alias
allow containers inside .pm __DATA__ config
Revision ChangesPath
1.4 +1 -1 modperl-2.0/Apache-Test/lib/Apache/TestConfig.pm
Index: TestConfig.pm
===
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- TestConfig.pm 2001/04/02 20:07:38 1.3
+++ TestConfig.pm 2001/04/03 00:26:58 1.4
@@ -221,7 +221,7 @@
}
else {
$args = "$directive " .
- (ref($arg) (ref($arg) eq 'ARRAY') ? "@$arg" : $arg);
+ (ref($arg) (ref($arg) eq 'ARRAY') ? "@$arg" : $arg || "");
}
push @{ $self-{$where} }, $args;
1.4 +20 -1 modperl-2.0/Apache-Test/lib/Apache/TestConfigPerl.pm
Index: TestConfigPerl.pm
===
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestConfigPerl.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- TestConfigPerl.pm 2001/04/02 23:45:55 1.3
+++ TestConfigPerl.pm 2001/04/03 00:26:58 1.4
@@ -158,6 +158,10 @@
$port;
}
+my %outside_container = map { $_, 1 } qw{
+Alias AliasMatch AddType
+};
+
#test .pm's can have configuration after the __DATA__ token
sub add_module_config {
my($self, $module, $args) = @_;
@@ -170,7 +174,22 @@
while ($fh) {
next unless /\S+/;
$self-replace;
-push @$args, split /\s+/, $_, 2;
+my($directive, $rest) = split /\s+/, $_, 2;
+if ($outside_container{$directive}) {
+$self-postamble($directive = $rest);
+}
+elsif ($directive =~ m/^(\w+)/) {
+$self-postamble($directive = $rest);
+my $end = "/$1";
+while ($fh) {
+$self-replace;
+$self-postamble($_);
+last if m:^\Q$end:;
+}
+}
+else {
+push @$args, $directive, $rest;
+}
}
}
cvs commit: modperl-2.0/t/filter/TestFilter lc.pm
dougm 01/04/02 17:28:27
Added: t/filter lc.t
t/filter/TestFilter lc.pm
Log:
add another filter test (lowercase filter)
Revision ChangesPath
1.1 modperl-2.0/t/filter/lc.t
Index: lc.t
===
use strict;
use warnings FATAL = 'all';
use Test;
use Apache::TestRequest;
plan tests = 1;
my $location = "/pod/modperl_2.0.pod";
my $str = GET_BODY $location;
ok $str !~ /[A-Z]/;
1.1 modperl-2.0/t/filter/TestFilter/lc.pm
Index: lc.pm
===
package TestFilter::lc;
use strict;
use warnings FATAL = 'all';
use Apache::Filter ();
sub handler {
my $filter = shift;
while ($filter-read(my $buffer, 1024)) {
$filter-print(lc $buffer);
}
0;
}
1;
__DATA__
Location /pod
PerlOutputFilterHandler TestFilter::lc
/Location
Alias /pod @top_dir@/pod
cvs commit: modperl-2.0/Apache-Test/t/conf - New directory
dougm 01/04/02 21:26:23 modperl-2.0/Apache-Test/t/conf - New directory
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c
dougm 01/04/02 22:23:47
Modified:src/modules/perl modperl_callback.c
Log:
if handler is resolved at request time and not duped (prefork-mpm case), need to use
s-process-pconf pool
Revision ChangesPath
1.37 +12 -2 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- modperl_callback.c2001/03/17 06:03:37 1.36
+++ modperl_callback.c2001/04/03 05:23:47 1.37
@@ -6,7 +6,7 @@
CV *cv=Nullcv;
I32 flags = G_EVAL|G_SCALAR;
dSP;
-int count, status;
+int count, status, duped=0;
#ifdef USE_ITHREADS
if (p !MpHandlerPARSED(handler) !MpHandlerDYNAMIC(handler)) {
@@ -17,6 +17,7 @@
* locking, so just copy it
*/
handler = modperl_handler_dup(p, handler);
+duped = 1;
}
}
#endif
@@ -24,8 +25,17 @@
MP_TRACE_h_do(MpHandler_dump_flags(handler, handler-name));
if (!MpHandlerPARSED(handler)) {
+apr_pool_t *rp = duped ? p : s-process-pconf;
MpHandlerAUTOLOAD_On(handler);
-if (!modperl_mgv_resolve(aTHX_ handler, p, handler-name)) {
+
+MP_TRACE_h(MP_FUNC,
+ "handler %s was not compiled at startup, "
+ "attempting to resolve using %s pool 0x%lx\n",
+ handler-name,
+ duped ? "current" : "server conf",
+ (unsigned long)rp);
+
+if (!modperl_mgv_resolve(aTHX_ handler, rp, handler-name)) {
MP_TRACE_h(MP_FUNC, "failed to resolve handler `%s'\n",
handler-name);
return HTTP_INTERNAL_SERVER_ERROR;
cvs commit: modperl-2.0/xs/Apache/Module Apache__Module.h
dougm 01/03/26 07:51:51 Modified:xs/Apache/Module Apache__Module.h Log: s/top_module/ap_top_module/ Revision ChangesPath 1.2 +1 -1 modperl-2.0/xs/Apache/Module/Apache__Module.h Index: Apache__Module.h === RCS file: /home/cvs/modperl-2.0/xs/Apache/Module/Apache__Module.h,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- Apache__Module.h 2001/03/25 22:32:10 1.1 +++ Apache__Module.h 2001/03/26 15:51:50 1.2 @@ -1,2 +1,2 @@ #define mpxs_Apache__Module_top_module(CLASS) \ -(CLASS ? top_module : top_module) +(CLASS ? ap_top_module : ap_top_module)
cvs commit: modperl-2.0/xs/tables - New directory
dougm 01/03/26 08:04:22 modperl-2.0/xs/tables - New directory
cvs commit: modperl-2.0/xs/tables/current/ModPerl - New directory
dougm 01/03/26 08:04:45 modperl-2.0/xs/tables/current/ModPerl - New directory
cvs commit: modperl-2.0/xs/tables/current/Apache StructureTable.pm
dougm 01/03/26 08:06:23
Added: xs/tables/current/Apache StructureTable.pm
Log:
current version of Apache::StructureTable (generated by C::Scan/Apache::ParseSource)
Revision ChangesPath
1.1 modperl-2.0/xs/tables/current/Apache/StructureTable.pm
Index: StructureTable.pm
===
package Apache::StructureTable;
# !!
# ! WARNING: generated by Apache::ParseSource/0.02
# ! Mon Mar 26 07:44:04 2001
# ! do NOT edit, any changes will be lost !
# !!
$Apache::StructureTable = [
{
'elts' = [
{
'name' = 'first',
'type' = 'union block_hdr *'
},
{
'name' = 'last',
'type' = 'union block_hdr *'
},
{
'name' = 'cleanups',
'type' = 'cleanup *'
},
{
'name' = 'subprocesses',
'type' = 'process_chain *'
},
{
'name' = 'sub_pools',
'type' = 'apr_pool_t *'
},
{
'name' = 'sub_next',
'type' = 'apr_pool_t *'
},
{
'name' = 'sub_prev',
'type' = 'apr_pool_t *'
},
{
'name' = 'parent',
'type' = 'apr_pool_t *'
},
{
'name' = 'free_first_avail',
'type' = 'char *'
},
{
'name' = 'apr_abort',
'type' = 'int(*)(int retcode)'
},
{
'name' = 'prog_data',
'type' = 'apr_hash_t *'
}
],
'type' = 'apr_pool_t'
},
{
'elts' = [
{
'name' = 'data',
'type' = 'unsigned char[16]'
}
],
'type' = 'apr_uuid_t'
},
{
'elts' = [
{
'name' = 'link',
'type' = '_ANON 63'
},
{
'name' = 'type',
'type' = 'const apr_bucket_type_t *'
},
{
'name' = 'length',
'type' = 'apr_off_t'
},
{
'name' = 'start',
'type' = 'apr_off_t'
},
{
'name' = 'data',
'type' = 'void *'
}
],
'type' = 'apr_bucket'
},
{
'elts' = [],
'type' = 'ap_HOOK_post_config_t'
},
{
'elts' = [],
'type' = 'apr_interface_e'
},
{
'elts' = [
{
'name' = 'tv_sec',
'type' = '__time_t'
},
{
'name' = 'tv_usec',
'type' = '__suseconds_t'
}
],
'type' = 'apr_os_imp_time_t'
},
{
'elts' = [
{
'name' = 'pFunc',
'type' = 'ap_HOOK_get_suexec_identity_t *'
},
{
'name' = 'szName',
'type' = 'const char *'
},
{
'name' = 'aszPredecessors',
'type' = 'const char * const *'
},
{
'name' = 'aszSuccessors',
'type' = 'const char * const *'
},
{
'name' = 'nOrder',
'type' = 'int'
}
],
'type' = 'ap_LINK_get_suexec_identity_t'
},
{
'elts' = [
{
'name' = 'pFunc',
'type' = 'ap_HOOK_http_method_t *'
},
{
'name' = 'szName',
'type' = 'const char *'
},
{
'name' = 'aszPredecessors',
'type' = 'const char * const *'
},
{
'name' = 'aszSuccessors',
'type' = 'const char * const *'
},
{
'name' = 'nOrder',
'type' = 'int'
}
],
'type' = 'ap_LINK_http_method_t'
},
{
'elts' = [
{
'name' = 'pool',
'type' = 'apr_pool_t *'
},
{
'name' = 'pconf',
'type' = 'apr_pool_t *'
},
{
'name' = 'argc',
'type' = 'int'
},
{
'name' = 'argv',
'type' = 'const char * const *'
},
{
'name' = 'short_name',
'type' = 'const char *'
}
],
'type' = 'process_rec'
},
{
'elts' = [],
'type' = 'apr_OFN_ap_ssi_parse_string_t'
},
{
'elts' = [],
'type' = 'ap_HOOK_optional_fn_retrieve_t'
},
{
'elts' = [
{
'name' = 'dptr',
'type' = 'char *'
},
{
'name' = 'dsize',
'type' = 'apr_size_t'
}
],
'type' = 'apr_datum_t'
},
{
'elts' = [],
'type' = 'apr_time_t'
},
{
'elts' = [
{
'name' = 'pool',
'type' = 'apr_pool_t *'
},
{
'name' = 'connection',
'type' = 'conn_rec *'
},
{
'name' = 'server
cvs commit: modperl-2.0/examples/lib - New directory
dougm 01/03/26 08:20:13 modperl-2.0/examples/lib - New directory
cvs commit: modperl-2.0/examples/lib/Apache - New directory
dougm 01/03/26 08:20:24 modperl-2.0/examples/lib/Apache - New directory
cvs commit: modperl-2.0 Makefile.PL
dougm 01/03/26 18:32:50
Modified:.Makefile.PL
Log:
only one version of the source tables is currently supported, so just hardwire it
for now
Revision ChangesPath
1.29 +3 -2 modperl-2.0/Makefile.PL
Index: Makefile.PL
===
RCS file: /home/cvs/modperl-2.0/Makefile.PL,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- Makefile.PL 2001/03/26 22:07:12 1.28
+++ Makefile.PL 2001/03/27 02:32:49 1.29
@@ -85,8 +85,9 @@
sub generate_xs {
my $httpd_version = shift;
-my $tables_version =
- $httpd_version =~ /-dev$/ ? 'current' : $httpd_version;
+my $tables_version = 'current';
+#XXX: support versioning
+#$httpd_version =~ /-dev$/ ? 'current' : $httpd_version;
my $tables_dir = "xs/tables/$tables_version";
unshift @INC, $tables_dir;
cvs commit: modperl-2.0 00README_FIRST
dougm 01/03/26 18:39:47 Modified:.00README_FIRST Log: add a hint about blib Revision ChangesPath 1.15 +8 -0 modperl-2.0/00README_FIRST Index: 00README_FIRST === RCS file: /home/cvs/modperl-2.0/00README_FIRST,v retrieving revision 1.14 retrieving revision 1.15 diff -u -r1.14 -r1.15 --- 00README_FIRST2001/03/26 16:21:35 1.14 +++ 00README_FIRST2001/03/27 02:39:47 1.15 @@ -49,6 +49,14 @@ PerlSwitches -T /home/dougm/test/startup.pl +hint: rather than 'make install' point mod_perl at your blib in startup.pl: + + use blib qw(/home/dougm/ap/modperl-2.0); + +or + + PerlSwitches -Mblib=/home/dougm/ap/modperl-2.0 + it is possible to configure Perl*Handlers and callback into apache, much is the same as 1.x, but plenty is different at the moment. there will be a compat layer in the future.
cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm
dougm 01/03/26 20:40:37
Modified:xs/Apache/RequestIO Apache__RequestIO.h
xs/tables/current/ModPerl FunctionTable.pm
Log:
fix Apache::RequestRec::TIEHANDLE
Revision ChangesPath
1.4 +4 -3 modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h
Index: Apache__RequestIO.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Apache__RequestIO.h 2001/03/16 05:32:35 1.3
+++ Apache__RequestIO.h 2001/03/27 04:40:36 1.4
@@ -68,8 +68,9 @@
return nrd;
}
-static MP_INLINE SV *mpxs_Apache__RequestRec_TIEHANDLE(SV *classname,
- SV *obj)
+static MP_INLINE
+request_rec *mpxs_Apache__RequestRec_TIEHANDLE(SV *classname,
+ request_rec *r)
{
-return obj;
+return r;
}
1.2 +4 -4 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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- FunctionTable.pm 2001/03/26 16:06:59 1.1
+++ FunctionTable.pm 2001/03/27 04:40:36 1.2
@@ -2,7 +2,7 @@
# !!
# ! WARNING: generated by ModPerl::ParseSource/0.01
-# ! Mon Mar 26 07:44:14 2001
+# ! Mon Mar 26 20:36:51 2001
# ! do NOT edit, any changes will be lost !
# !!
@@ -2685,15 +2685,15 @@
'name' = 'mpxs_ap_get_client_block'
},
{
-'return_type' = 'SV *',
+'return_type' = 'request_rec *',
'args' = [
{
'name' = 'classname',
'type' = 'SV *'
},
{
-'name' = 'obj',
-'type' = 'SV *'
+'name' = 'r',
+'type' = 'request_rec *'
}
],
'name' = 'mpxs_Apache__RequestRec_TIEHANDLE'
cvs commit: modperl-2.0/src/modules/perl modperl_mgv.c
dougm 01/03/25 11:04:56
Modified:src/modules/perl modperl_mgv.c
Log:
prevent core dump if HvARRAY is NULL
Revision ChangesPath
1.9 +3 -0 modperl-2.0/src/modules/perl/modperl_mgv.c
Index: modperl_mgv.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_mgv.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_mgv.c 2001/03/17 06:03:37 1.8
+++ modperl_mgv.c 2001/03/25 19:04:56 1.9
@@ -30,6 +30,9 @@
register HE *entry;
xhv = (XPVHV *)SvANY(hv);
+if (!xhv-xhv_array) {
+return 0;
+}
entry = ((HE**)xhv-xhv_array)[hash (I32) xhv-xhv_max];
for (; entry; entry = HeNEXT(entry)) {
cvs commit: modperl-2.0/xs/Apache/Command - New directory
dougm 01/03/25 14:30:12 modperl-2.0/xs/Apache/Command - New directory
cvs commit: modperl-2.0/xs/Apache/Module - New directory
dougm 01/03/25 14:30:12 modperl-2.0/xs/Apache/Module - New directory
cvs commit: modperl-2.0/xs/maps apache_functions.map apache_structures.map
dougm 01/03/25 14:32:11
Modified:xs/maps apache_functions.map apache_structures.map
Added: xs/Apache/Command Apache__Command.h
xs/Apache/Directive Apache__Directive.h
xs/Apache/Module Apache__Module.h
Log:
enabled Apache::{Directive,Command,Module} modules
add wrappers to access ap_conftree, "command_rec-next" and top_module
Revision ChangesPath
1.1 modperl-2.0/xs/Apache/Command/Apache__Command.h
Index: Apache__Command.h
===
#define mpxs_Apache__Command_next(cmd) \
(++cmd, ((cmd cmd-name) ? cmd : NULL))
1.1 modperl-2.0/xs/Apache/Directive/Apache__Directive.h
Index: Apache__Directive.h
===
#define mpxs_Apache__Directive_conftree(CLASS) \
(CLASS ? ap_conftree : ap_conftree)
1.1 modperl-2.0/xs/Apache/Module/Apache__Module.h
Index: Apache__Module.h
===
#define mpxs_Apache__Module_top_module(CLASS) \
(CLASS ? top_module : top_module)
1.7 +9 -6 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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- apache_functions.map 2001/03/17 17:33:03 1.6
+++ apache_functions.map 2001/03/25 22:32:11 1.7
@@ -150,7 +150,8 @@
ap_open_stderr_log
ap_open_logs
-!MODULE=Apache::Module
+MODULE=Apache::Module
+ module *:DEFINE_top_module | | SV *:CLASS
-ap_add_loaded_module
-ap_add_module
-ap_add_named_module
@@ -164,10 +165,11 @@
ap_show_modules
ap_register_hooks
-!MODULE=Apache::Directive
- ap_add_node
- ap_build_config
- ap_build_cont_config
+MODULE=Apache::Directive
+ ap_directive_t *:DEFINE_conftree | | SV *:CLASS
+!ap_add_node
+!ap_build_config
+!ap_build_cont_config
ap_walk_config
ap_process_config_tree
@@ -216,7 +218,8 @@
ap_parse_htaccess
ap_process_resource_config
-!MODULE=Apache::Command
+MODULE=Apache::Command
+ command_rec *:DEFINE_next | | command_rec *:cmd
ap_check_cmd_context
ap_soak_end_container
-ap_set_file_slot
1.2 +3 -3 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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- apache_structures.map 2001/03/05 03:49:12 1.1
+++ apache_structures.map 2001/03/25 22:32:11 1.2
@@ -126,7 +126,7 @@
virthost
/server_addr_rec
-!module
+module
version
minor_version
module_index
@@ -151,7 +151,7 @@
short_name
/process_rec
-!command_rec
+command_rec
name
func
cmd_data
@@ -180,7 +180,7 @@
method_list
/ap_method_list_t
-!ap_directive_t
+ap_directive_t
directive
args
next
cvs commit: modperl-2.0/src/modules/perl modperl_interp.c
dougm 01/03/25 16:36:39
Modified:src/modules/perl modperl_interp.c
Log:
look higher up the chain for the interpreter to share across subrequests
Revision ChangesPath
1.29 +16 -4 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.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- modperl_interp.c 2001/03/17 04:41:52 1.28
+++ modperl_interp.c 2001/03/26 00:36:39 1.29
@@ -212,13 +212,16 @@
*/
#define MP_INTERP_KEY "MODPERL_INTERP"
+#define get_interp(p) \
+(void)apr_pool_userdata_get((void **)interp, MP_INTERP_KEY, p)
+
modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
server_rec *s)
{
MP_dSCFG(s);
modperl_config_dir_t *dcfg = modperl_config_dir_get(r);
const char *desc = NULL;
-modperl_interp_t *interp;
+modperl_interp_t *interp = NULL;
apr_pool_t *p = NULL;
int is_subrequest = (r r-main) ? 1 : 0;
modperl_interp_lifetime_e lifetime;
@@ -252,7 +255,7 @@
if (c (lifetime == MP_INTERP_LIFETIME_CONNECTION)) {
desc = "conn_rec pool";
-(void)apr_pool_userdata_get((void **)interp, MP_INTERP_KEY, c-pool);
+get_interp(c-pool);
if (interp) {
MP_TRACE_i(MP_FUNC,
@@ -266,14 +269,23 @@
else if (r) {
if (is_subrequest (lifetime == MP_INTERP_LIFETIME_REQUEST)) {
/* share 1 interpreter across sub-requests */
-p = r-main-pool;
+request_rec *main_r = r-main;
+
+while (main_r !interp) {
+p = main_r-pool;
+get_interp(p);
+MP_TRACE_i(MP_FUNC,
+ "looking for interp in main request for %s...%s\n",
+ main_r-uri, interp ? "found" : "not found");
+main_r = main_r-main;
+}
}
else {
p = r-pool;
+get_interp(p);
}
desc = "request_rec pool";
-(void)apr_pool_userdata_get((void **)interp, MP_INTERP_KEY, p);
if (interp) {
MP_TRACE_i(MP_FUNC,
cvs commit: modperl-2.0/src/modules/perl modperl_config.c modperl_handler.c modperl_handler.h modperl_mgv.c modperl_mgv.h
dougm 01/03/25 17:08:30
Modified:lib/ModPerl Code.pm
src/modules/perl modperl_config.c modperl_handler.c
modperl_handler.h modperl_mgv.c modperl_mgv.h
Log:
add support for proper merge of handlers
example:
PerlFixupHandler One::fixup
Location /foo
PerlFixupHandler Another::fixup
/Location
default request for /foo only runs Another::fixup (1.x behavior)
PerlOptions +MergeHandlers (inside Location /foo)
will run both One::fixup and Another::fixup
Revision ChangesPath
1.53 +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.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- Code.pm 2001/03/25 17:42:26 1.52
+++ Code.pm 2001/03/26 01:08:28 1.53
@@ -89,8 +89,9 @@
#XXX: allow disabling of PerDir hooks on a PerDir basis
my @hook_flags = (map { canon_uc($_) } keys %hooks);
my %flags = (
-Srv = [qw(NONE CLONE PARENT ENABLED AUTOLOAD), @hook_flags, 'UNSET'],
-Dir = [qw(NONE SEND_HEADER SETUP_ENV UNSET)],
+Srv = [qw(NONE CLONE PARENT ENABLED AUTOLOAD MERGE_HANDLERS),
+@hook_flags, 'UNSET'],
+Dir = [qw(NONE SEND_HEADER SETUP_ENV MERGE_HANDLERS UNSET)],
Interp = [qw(NONE IN_USE PUTBACK CLONED BASE)],
Handler = [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC)],
);
1.29 +31 -25modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- modperl_config.c 2001/03/25 17:42:26 1.28
+++ modperl_config.c 2001/03/26 01:08:29 1.29
@@ -15,8 +15,19 @@
#define merge_item(item) \
mrg-item = add-item ? add-item : base-item
+#define merge_handlers(merge_flag, array) \
+if (merge_flag(mrg)) { \
+mrg-array = modperl_handler_array_merge(p, \
+ base-array, \
+ add-array); \
+} \
+else { \
+merge_item(array); \
+}
+
void *modperl_config_dir_merge(apr_pool_t *p, void *basev, void *addv)
{
+int i;
modperl_config_dir_t
*base = (modperl_config_dir_t *)basev,
*add = (modperl_config_dir_t *)addv,
@@ -29,16 +40,13 @@
merge_item(interp_lifetime);
#endif
-{ /* XXX: should do a proper merge of the arrays */
- /* XXX: and check if Perl*Handler is disabled */
-int i;
-for (i=0; i MP_HANDLER_NUM_PER_DIR; i++) {
-merge_item(handlers_per_dir[i]);
-}
-}
-
mrg-flags = modperl_options_merge(p, base-flags, add-flags);
+/* XXX: check if Perl*Handler is disabled */
+for (i=0; i MP_HANDLER_NUM_PER_DIR; i++) {
+merge_handlers(MpDirMERGE_HANDLERS, handlers_per_dir[i]);
+}
+
return mrg;
}
@@ -132,6 +140,7 @@
/* XXX: this is not complete */
void *modperl_config_srv_merge(apr_pool_t *p, void *basev, void *addv)
{
+int i;
modperl_config_srv_t
*base = (modperl_config_srv_t *)basev,
*add = (modperl_config_srv_t *)addv,
@@ -151,24 +160,21 @@
merge_item(argv);
-{ /* XXX: should do a proper merge of the arrays */
- /* XXX: and check if Perl*Handler is disabled */
-int i;
-for (i=0; i MP_HANDLER_NUM_PER_SRV; i++) {
-merge_item(handlers_per_srv[i]);
-}
-for (i=0; i MP_HANDLER_NUM_FILES; i++) {
-merge_item(handlers_files[i]);
-}
-for (i=0; i MP_HANDLER_NUM_PROCESS; i++) {
-merge_item(handlers_process[i]);
-}
-for (i=0; i MP_HANDLER_NUM_CONNECTION; i++) {
-merge_item(handlers_connection[i]);
-}
-}
-
mrg-flags = modperl_options_merge(p, base-flags, add-flags);
+
+/* XXX: check if Perl*Handler is disabled */
+for (i=0; i MP_HANDLER_NUM_PER_SRV; i++) {
+merge_handlers(MpSrvMERGE_HANDLERS, handlers_per_srv[i]);
+}
+for (i=0; i MP_HANDLER_NUM_FILES; i++) {
+merge_handlers(MpSrvMERGE_HANDLERS, handlers_files[i]);
+}
+for (i=0; i MP_HANDLER_NUM_PROCESS; i++) {
+merge_handlers(MpSrvMERGE_HANDLERS, handlers_process[i]);
+}
+for (i=0; i MP_HANDLER_NUM_CONNECTION; i++) {
+merge_handlers(MpSrvMERGE_HANDLERS, handlers_connection[i]);
+}
return mrg;
}
1.7 +45 -0 modperl-2.0/src/modules/perl/modperl_handler.c
Index: modperl_handler.c
cvs commit: modperl-2.0/xs/maps modperl_functions.map apache_functions.map
dougm 01/03/17 09:33:03 Modified:xs/maps apache_functions.map Added: xs/maps modperl_functions.map Log: move modperl specific functions into their own .map file Revision ChangesPath 1.6 +0 -18 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.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- apache_functions.map 2001/03/17 06:03:38 1.5 +++ apache_functions.map 2001/03/17 17:33:03 1.6 @@ -44,15 +44,6 @@ !ap_content_type_tolower ap_get_status_line ap_is_initial_req - mpxs_Apache__RequestRec_push_handlers - mpxs_Apache__RequestRec_set_handlers - mpxs_Apache__RequestRec_get_handlers - - #protocol module helpers - mpxs_Apache__RequestRec_location_merge - mpxs_Apache__RequestRec_set_basic_credentials -PACKAGE=Apache::RequestRec - mpxs_Apache__RequestRec_new #MODULE=Apache::RequestConfig ap_document_root @@ -89,8 +80,6 @@ ap_rvputs | mpxs_ | ... | puts -ap_vrprintf - mpxs_Apache__RequestRec_TIEHANDLE - MODULE=Apache::Response PACKAGE=guess ap_make_etag ap_set_content_length @@ -137,9 +126,6 @@ ap_construct_server ap_construct_url | | r,uri,p ap_error_log2stderr - mpxs_Apache__Server_push_handlers - mpxs_Apache__Server_set_handlers - mpxs_Apache__Server_get_handlers #MODULE=Apache::ServerConfig ap_exists_config_define @@ -188,10 +174,6 @@ MODULE=Apache::Filter PACKAGE=Apache::RequestRec ap_filter_t *:DEFINE_add_output_filter | | \ request_rec *:r, const char *:name, void *:ctx - -PACKAGE=Apache::OutputFilter - mpxs_Apache__OutputFilter_print | | ... - mpxs_Apache__OutputFilter_read | | ... PACKAGE=guess ~ap_add_output_filter 1.1 modperl-2.0/xs/maps/modperl_functions.map Index: modperl_functions.map === #modperl specfic functions MODULE=Apache::RequestUtil PACKAGE=guess mpxs_Apache__RequestRec_push_handlers mpxs_Apache__RequestRec_set_handlers mpxs_Apache__RequestRec_get_handlers #protocol module helpers mpxs_Apache__RequestRec_location_merge mpxs_Apache__RequestRec_set_basic_credentials PACKAGE=Apache::RequestRec mpxs_Apache__RequestRec_new MODULE=Apache::RequestIO PACKAGE=Apache::RequestRec mpxs_Apache__RequestRec_TIEHANDLE MODULE=Apache::ServerUtil PACKAGE=guess mpxs_Apache__Server_push_handlers mpxs_Apache__Server_set_handlers mpxs_Apache__Server_get_handlers MODULE=Apache::Filter PACKAGE=Apache::OutputFilter mpxs_Apache__OutputFilter_print | | ... mpxs_Apache__OutputFilter_read | | ...
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_callback.h modperl_handler.c modperl_handler.h modperl_types.h
dougm 01/03/16 09:23:31
Modified:src/modules/perl modperl_callback.c modperl_callback.h
modperl_handler.c modperl_handler.h modperl_types.h
Log:
prototype the 3 pools in run_handlers() rather that use va_args,
so we can have a pool sooner rather than later
pass lookup_hanalders() an lvalue arg and pool so it can create the
handler array if needed
add handler vectors to per-request config (will be used for set/push handlers)
Revision ChangesPath
1.35 +38 -51modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- modperl_callback.c2001/03/16 06:57:42 1.34
+++ modperl_callback.c2001/03/16 17:23:23 1.35
@@ -91,8 +91,11 @@
return status;
}
-int modperl_callback_run_handlers(int idx, request_rec *r, conn_rec *c,
- server_rec *s, int type, ...)
+int modperl_callback_run_handlers(int idx, int type,
+ request_rec *r, conn_rec *c, server_rec *s,
+ apr_pool_t *pconf,
+ apr_pool_t *plog,
+ apr_pool_t *ptemp)
{
#ifdef USE_ITHREADS
pTHX;
@@ -105,7 +108,6 @@
MpAV *av, **avp;
int i, status = OK;
const char *desc = NULL;
-va_list args;
AV *av_args = Nullav;
if (!MpSrvENABLED(scfg)) {
@@ -114,8 +116,15 @@
return DECLINED;
}
-avp = modperl_handler_lookup_handlers(dcfg, scfg, NULL,
- type, idx, desc);
+if (r || c) {
+p = c ? c-pool : r-pool;
+}
+else {
+p = pconf;
+}
+
+avp = modperl_handler_lookup_handlers(dcfg, scfg, NULL, p,
+ type, idx, FALSE, desc);
if (!(avp (av = *avp))) {
MP_TRACE_h(MP_FUNC, "no %s handlers configured (%s)\n",
@@ -128,7 +137,6 @@
c = r-connection;
}
if (r || c) {
-p = c ? c-pool : r-pool;
interp = modperl_interp_select(r, c, s);
aTHX = interp-perl;
}
@@ -150,39 +158,17 @@
"Apache::Connection", c, NULL);
break;
case MP_HANDLER_TYPE_FILES:
- {
- apr_pool_t *pconf, *plog, *ptemp;
-
- va_start(args, type);
- pconf = va_arg(args, apr_pool_t *);
- plog = va_arg(args, apr_pool_t *);
- ptemp = va_arg(args, apr_pool_t *);
- va_end(args);
-
- modperl_handler_make_args(aTHX_ av_args,
-"Apache::Pool", pconf,
-"Apache::Pool", plog,
-"Apache::Pool", ptemp,
-"Apache::Server", s, NULL);
- }
- break;
+modperl_handler_make_args(aTHX_ av_args,
+ "Apache::Pool", pconf,
+ "Apache::Pool", plog,
+ "Apache::Pool", ptemp,
+ "Apache::Server", s, NULL);
+break;
case MP_HANDLER_TYPE_PROCESS:
- {
- apr_pool_t *pconf;
-
- va_start(args, type);
- pconf = va_arg(args, apr_pool_t *);
- va_end(args);
-
- if (!p) {
- p = pconf;
- }
-
- modperl_handler_make_args(aTHX_ av_args,
-"Apache::Pool", pconf,
-"Apache::Server", s, NULL);
- }
- break;
+modperl_handler_make_args(aTHX_ av_args,
+ "Apache::Pool", pconf,
+ "Apache::Server", s, NULL);
+break;
};
MP_TRACE_h(MP_FUNC, "running %d %s handlers\n",
@@ -212,36 +198,37 @@
int modperl_callback_per_dir(int idx, request_rec *r)
{
-return modperl_callback_run_handlers(idx, r, NULL,
- r-server,
- MP_HANDLER_TYPE_PER_DIR);
+return modperl_callback_run_handlers(idx, MP_HANDLER_TYPE_PER_DIR,
+ r, NULL, r-server,
+
cvs commit: modperl-2.0/xs/Apache/ServerUtil - New directory
dougm 01/03/16 21:59:45 modperl-2.0/xs/Apache/ServerUtil - New directory
cvs commit: modperl-2.0/xs/maps apache_functions.map
dougm 01/03/16 22:03:38
Modified:lib/ModPerl Code.pm
src/modules/perl modperl_callback.c modperl_config.h
modperl_handler.c modperl_handler.h modperl_mgv.c
modperl_mgv.h
xs/Apache/RequestUtil Apache__RequestUtil.h
xs/maps apache_functions.map
Added: xs/Apache/ServerUtil Apache__ServerUtil.h
Log:
implement ${r,s}-{push,set,get}_handlers}
Revision ChangesPath
1.51 +1 -1 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.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- Code.pm 2001/03/16 07:30:21 1.50
+++ Code.pm 2001/03/17 06:03:37 1.51
@@ -92,7 +92,7 @@
Srv = [qw(NONE CLONE PARENT ENABLED AUTOLOAD), @hook_flags, 'UNSET'],
Dir = [qw(NONE SEND_HEADER SETUP_ENV UNSET)],
Interp = [qw(NONE IN_USE PUTBACK CLONED BASE)],
-Handler = [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD)],
+Handler = [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD DYNAMIC)],
);
my %flags_lookup = map { $_,1 } qw(Srv Dir);
1.36 +4 -2 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- modperl_callback.c2001/03/16 17:23:23 1.35
+++ modperl_callback.c2001/03/17 06:03:37 1.36
@@ -9,7 +9,7 @@
int count, status;
#ifdef USE_ITHREADS
-if (p !MpHandlerPARSED(handler)) {
+if (p !MpHandlerPARSED(handler) !MpHandlerDYNAMIC(handler)) {
MP_dSCFG(s);
if (scfg-threaded_mpm) {
/*
@@ -103,6 +103,7 @@
#endif
MP_dSCFG(s);
MP_dDCFG;
+MP_dRCFG;
modperl_handler_t **handlers;
apr_pool_t *p = NULL;
MpAV *av, **avp;
@@ -123,7 +124,7 @@
p = pconf;
}
-avp = modperl_handler_lookup_handlers(dcfg, scfg, NULL, p,
+avp = modperl_handler_lookup_handlers(dcfg, scfg, rcfg, p,
type, idx, FALSE, desc);
if (!(avp (av = *avp))) {
@@ -171,6 +172,7 @@
break;
};
+/* XXX: deal with {push,set}_handler of the phase we're currently in */
MP_TRACE_h(MP_FUNC, "running %d %s handlers\n",
av-nelts, desc);
handlers = (modperl_handler_t **)av-elts;
1.24 +4 -0 modperl-2.0/src/modules/perl/modperl_config.h
Index: modperl_config.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- modperl_config.h 2001/03/16 06:35:18 1.23
+++ modperl_config.h 2001/03/17 06:03:37 1.24
@@ -37,6 +37,10 @@
(r ? (modperl_config_dir_t *) \
ap_get_module_config(r-per_dir_config, perl_module) : NULL)
+#define modperl_config_dir_get_defaults(s) \
+ (modperl_config_dir_t *) \
+ ap_get_module_config(s-lookup_defaults, perl_module)
+
#define MP_dDCFG \
modperl_config_dir_t *dcfg = modperl_config_dir_get(r)
1.6 +216 -5modperl-2.0/src/modules/perl/modperl_handler.c
Index: modperl_handler.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_handler.c 2001/03/16 17:23:24 1.5
+++ modperl_handler.c 2001/03/17 06:03:37 1.6
@@ -64,41 +64,252 @@
#define set_desc(dtype) \
MP_TRACE_a_do(if (desc) *desc = modperl_handler_desc_##dtype(idx))
+#define check_modify(dtype) \
+if ((action MP_HANDLER_ACTION_GET) rcfg) { \
+dTHX; \
+Perl_croak(aTHX_ "too late to modify %s handlers", \
+ modperl_handler_desc_##dtype(idx)); \
+}
+
+/*
+ * generic function to lookup handlers for use in modperl_callback(),
+ * $r-{push,set,get}_handlers, $s-{push,set,get}_handlers
+ * $s-push/set at startup time are the same as configuring Perl*Handlers
+ * $r-push/set at request time will create entries in r-request_config
+ * push will first merge with configured handlers, unless an entry
+ * in r-request_config already exists. in this case, push or set has
+ * already been called for the given handler,
+ * r-request_config entries then override those in r-per_dir_config
+ */
+
MpAV **modperl_handler_lookup_handlers(modper
cvs commit: modperl-2.0/src/modules/perl modperl_cmd.c
dougm 01/03/16 22:08:05
Modified:src/modules/perl modperl_cmd.c
Log:
make use of modperl_handler_array_ macros
Revision ChangesPath
1.2 +2 -2 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_cmd.c 2001/03/16 05:52:29 1.1
+++ modperl_cmd.c 2001/03/17 06:08:05 1.2
@@ -6,13 +6,13 @@
modperl_handler_t *h = modperl_handler_new(p, name);
if (!*handlers) {
-*handlers = apr_array_make(p, 1, sizeof(modperl_handler_t *));
+*handlers = modperl_handler_array_new(p);
MP_TRACE_d(MP_FUNC, "created handler stack\n");
}
/* XXX parse_handler if Perl is running */
-*(modperl_handler_t **)apr_array_push(*handlers) = h;
+modperl_handler_array_push(*handlers, h);
MP_TRACE_d(MP_FUNC, "pushed handler: %s\n", h-name);
return NULL;
cvs commit: modperl-2.0/xs/maps apr_functions.map apr_structures.map apr_types.map
dougm 01/03/15 16:01:39 Modified:xs/maps apr_functions.map apr_structures.map apr_types.map Log: add new apr_ipsubnet_ functions Revision ChangesPath 1.4 +5 -1 modperl-2.0/xs/maps/apr_functions.map Index: apr_functions.map === RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v retrieving revision 1.3 retrieving revision 1.4 diff -u -r1.3 -r1.4 --- apr_functions.map 2001/03/13 05:25:11 1.3 +++ apr_functions.map 2001/03/16 00:01:36 1.4 @@ -327,11 +327,15 @@ apr_get_user_passwd apr_get_userid -!MODULE=APR::NetworkIO +MODULE=APR::NetLib apr_gethostname apr_getnameinfo -apr_getservbyname apr_parse_addr_port +PACKAGE=guess + apr_ipsubnet_t *:apr_ipsubnet_create | mpxs_ | \ + SV *:CLASS, p, ipstr, mask_or_numbits=NULL | new + apr_ipsubnet_test !MODULE=APR::Getopt apr_getopt 1.2 +1 -1 modperl-2.0/xs/maps/apr_structures.map Index: apr_structures.map === RCS file: /home/cvs/modperl-2.0/xs/maps/apr_structures.map,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- apr_structures.map2001/03/05 03:49:21 1.1 +++ apr_structures.map2001/03/16 00:01:37 1.2 @@ -2,7 +2,7 @@ IGNORE: apr_pool_t apr_os_ apr_vformatter_buff_t apr_pool_t \ apr_table_t apr_in_addr_t apr_bucket_ apr_md5_ctx_t apr_sha1_ctx_t \ -apr_uuid_t apr_datum_t apr_mmap_t apr_hdtr_t +apr_uuid_t apr_datum_t apr_mmap_t apr_hdtr_t apr_ipsubnet_t #buckets 1.2 +3 -0 modperl-2.0/xs/maps/apr_types.map Index: apr_types.map === RCS file: /home/cvs/modperl-2.0/xs/maps/apr_types.map,v retrieving revision 1.1 retrieving revision 1.2 diff -u -r1.1 -r1.2 --- apr_types.map 2001/03/05 03:49:21 1.1 +++ apr_types.map 2001/03/16 00:01:37 1.2 @@ -15,6 +15,9 @@ apr_shutdown_how_e | UNDEFINED apr_interface_e | UNDEFINED +#netlib stuff +struct apr_ipsubnet_t | APR::IpSubnet + #bucket stuff struct apr_bucket | APR::Bucket struct apr_bucket_brigade | APR::Brigade
cvs commit: modperl-2.0/xs/APR/NetLib APR__NetLib.h
dougm 01/03/15 16:02:50
Added: xs/APR/NetLib APR__NetLib.h
Log:
wrapper for apr_ipsubnet_create()
Revision ChangesPath
1.1 modperl-2.0/xs/APR/NetLib/APR__NetLib.h
Index: APR__NetLib.h
===
static MP_INLINE
apr_ipsubnet_t *mpxs_apr_ipsubnet_create(pTHX_ SV *classname, apr_pool_t *p,
const char *ipstr,
const char *mask_or_numbits)
{
apr_status_t status;
apr_ipsubnet_t *ipsub = NULL;
status = apr_ipsubnet_create(ipsub, ipstr, mask_or_numbits, p);
return ipsub;
}
cvs commit: modperl-2.0/lib/Apache SourceTables.pm
dougm 01/03/15 18:30:47
Added: lib/Apache SourceTables.pm
Log:
module to include the generated source tables and build hash versions of each
Revision ChangesPath
1.1 modperl-2.0/lib/Apache/SourceTables.pm
Index: SourceTables.pm
===
package Apache::SourceTables;
use Apache::StructureTable ();
use Apache::FunctionTable ();
#build hash versions of the tables
%Apache::StructureTable =
map { $_-{type}, $_-{elts} } @$Apache::StructureTable;
%Apache::FunctionTable =
map { $_-{name}, {elts = $_-{elts},
return_type = $_-{return_type} } }
@$Apache::FunctionTable;
1;
__END__
cvs commit: modperl-2.0/util apr_pool_check.pl
dougm 01/03/15 18:32:44
Added: util apr_pool_check.pl
Log:
script to check which apr_ functions do not have access to a pool
Revision ChangesPath
1.1 modperl-2.0/util/apr_pool_check.pl
Index: apr_pool_check.pl
===
#check which apr_ functions do not have access to a pool
use lib qw(lib);
use strict;
use Apache::SourceTables ();
my($functions, @nopool);
#incomplete types (C::Scan only scans *.h, not *.c) we know have an apr_pool_t
my %private = map { $_, 1 } qw{
apr_dir_t apr_file_t apr_dso_handle_t apr_hash_t apr_hash_index_t apr_lock_t
apr_socket_t apr_pollfd_t apr_threadattr_t apr_thread_t apr_threadkey_t
apr_procattr_t apr_xlate_t apr_dbm_t apr_xml_parser
};
for my $entry (@$Apache::FunctionTable) {
next unless $entry-{name} =~ /^apr_/;
$functions++;
unless (grep { find_pool($_-{type}) } @{ $entry-{args} }) {
push @nopool, $entry;
}
}
my $num_nopool = @nopool;
print "$num_nopool functions (out of $functions) do not have access to a pool:\n\n";
for my $entry (@nopool) {
print "$entry-{return_type} $entry-{name}(",
(join ', ', map "$_-{type} $_-{name}", @{ $entry-{args} }),
")\n\n";
}
sub find_pool {
my $type = shift;
return 1 if $type =~ /^apr_pool_t/;
$type =~ s/\s+\*+$//;
$type =~ s/^(const|struct)\s+//g;
if (my $elts = $Apache::StructureTable{$type}) {
return 1 if $private{$type};
for my $e (@$elts) {
next if $e-{type} =~ /^$type/;
return 1 if find_pool($e-{type});
}
}
}
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_callback.c modperl_callback.h
dougm 01/03/15 21:08:15
Modified:lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_callback.c
modperl_callback.h
Log:
use proper prefix for all modperl_callback_ functions
Revision ChangesPath
1.46 +1 -1 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.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- Code.pm 2001/03/16 04:58:57 1.45
+++ Code.pm 2001/03/16 05:08:15 1.46
@@ -167,7 +167,7 @@
my @register_hooks;
while (my($class, $prototype) = each %{ $self-{hook_proto} }) {
-my $callback = canon_func($class, 'callback');
+my $callback = canon_func('callback', $class);
my $return = $prototype-{ret} eq 'void' ? '' : 'return';
my $i = -1;
1.37 +1 -1 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.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- mod_perl.c2001/03/15 04:34:04 1.36
+++ mod_perl.c2001/03/16 05:08:15 1.37
@@ -286,7 +286,7 @@
modperl_response_init(r);
-retval = modperl_per_dir_callback(MP_RESPONSE_HANDLER, r);
+retval = modperl_callback_per_dir(MP_RESPONSE_HANDLER, r);
if ((retval == DECLINED) r-content_type) {
r-handler = r-content_type; /* let http_core or whatever try */
1.31 +21 -16modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- modperl_callback.c2001/03/16 04:58:58 1.30
+++ modperl_callback.c2001/03/16 05:08:15 1.31
@@ -91,8 +91,8 @@
return status;
}
-int modperl_run_handlers(int idx, request_rec *r, conn_rec *c,
- server_rec *s, int type, ...)
+int modperl_callback_run_handlers(int idx, request_rec *r, conn_rec *c,
+ server_rec *s, int type, ...)
{
#ifdef USE_ITHREADS
pTHX;
@@ -230,33 +230,38 @@
return status;
}
-int modperl_per_dir_callback(int idx, request_rec *r)
+int modperl_callback_per_dir(int idx, request_rec *r)
{
-return modperl_run_handlers(idx, r, NULL, r-server,
-MP_HANDLER_TYPE_PER_DIR);
+return modperl_callback_run_handlers(idx, r, NULL,
+ r-server,
+ MP_HANDLER_TYPE_PER_DIR);
}
-int modperl_per_srv_callback(int idx, request_rec *r)
+int modperl_callback_per_srv(int idx, request_rec *r)
{
-return modperl_run_handlers(idx, r, NULL, r-server,
-MP_HANDLER_TYPE_PER_SRV);
+return modperl_callback_run_handlers(idx, r, NULL,
+ r-server,
+ MP_HANDLER_TYPE_PER_SRV);
}
-int modperl_connection_callback(int idx, conn_rec *c)
+int modperl_callback_connection(int idx, conn_rec *c)
{
-return modperl_run_handlers(idx, NULL, c, c-base_server,
-MP_HANDLER_TYPE_CONNECTION);
+return modperl_callback_run_handlers(idx, NULL, c,
+ c-base_server,
+ MP_HANDLER_TYPE_CONNECTION);
}
-void modperl_process_callback(int idx, apr_pool_t *p, server_rec *s)
+void modperl_callback_process(int idx, apr_pool_t *p, server_rec *s)
{
-modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_PROCESS, p);
+modperl_callback_run_handlers(idx, NULL, NULL, s,
+ MP_HANDLER_TYPE_PROCESS, p);
}
-void modperl_files_callback(int idx,
+void modperl_callback_files(int idx,
apr_pool_t *pconf, apr_pool_t *plog,
apr_pool_t *ptemp, server_rec *s)
{
-modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_FILES,
- pconf, plog, ptemp);
+modperl_callback_run_handlers(idx, NULL, NULL, s,
+ MP_HANDLER_TYPE_FILES,
+ pconf, plog, ptemp);
}
1.17 +9 -9 modperl-2.0/src/modules/perl/modperl_callback.h
Index: modperl_callback.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl
cvs commit: modperl-2.0/src/modules/perl modperl_cmd.c modperl_cmd.h mod_perl.c mod_perl.h modperl_config.c modperl_config.h modperl_interp.c modperl_interp.h
dougm 01/03/15 21:52:29
Modified:lib/ModPerl Code.pm
src/modules/perl mod_perl.c mod_perl.h modperl_config.c
modperl_config.h modperl_interp.c modperl_interp.h
Added: src/modules/perl modperl_cmd.c modperl_cmd.h
Log:
move cmd stuffs into its own module
Revision ChangesPath
1.48 +1 -1 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.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- Code.pm 2001/03/16 05:32:34 1.47
+++ Code.pm 2001/03/16 05:52:28 1.48
@@ -511,7 +511,7 @@
generate_trace = {h = 'modperl_trace.h'},
);
-my @c_src_names = qw(interp tipool log config options callback handler
+my @c_src_names = qw(interp tipool log config cmd options callback handler
gtop util filter mgv pcw);
my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names));
1.39 +9 -9 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.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- mod_perl.c2001/03/16 05:32:35 1.38
+++ mod_perl.c2001/03/16 05:52:29 1.39
@@ -233,23 +233,23 @@
}
static const command_rec modperl_cmds[] = {
-MP_SRV_CMD_ITERATE("PerlSwitches", switches, "Perl Switches"),
-MP_SRV_CMD_ITERATE("PerlOptions", options, "Perl Options"),
+MP_CMD_SRV_ITERATE("PerlSwitches", switches, "Perl Switches"),
+MP_CMD_SRV_ITERATE("PerlOptions", options, "Perl Options"),
#ifdef MP_TRACE
-MP_SRV_CMD_TAKE1("PerlTrace", trace, "Trace level"),
+MP_CMD_SRV_TAKE1("PerlTrace", trace, "Trace level"),
#endif
#ifdef USE_ITHREADS
-MP_SRV_CMD_TAKE1("PerlInterpStart", interp_start,
+MP_CMD_SRV_TAKE1("PerlInterpStart", interp_start,
"Number of Perl interpreters to start"),
-MP_SRV_CMD_TAKE1("PerlInterpMax", interp_max,
+MP_CMD_SRV_TAKE1("PerlInterpMax", interp_max,
"Max number of running Perl interpreters"),
-MP_SRV_CMD_TAKE1("PerlInterpMaxSpare", interp_max_spare,
+MP_CMD_SRV_TAKE1("PerlInterpMaxSpare", interp_max_spare,
"Max number of spare Perl interpreters"),
-MP_SRV_CMD_TAKE1("PerlInterpMinSpare", interp_min_spare,
+MP_CMD_SRV_TAKE1("PerlInterpMinSpare", interp_min_spare,
"Min number of spare Perl interpreters"),
-MP_SRV_CMD_TAKE1("PerlInterpMaxRequests", interp_max_requests,
+MP_CMD_SRV_TAKE1("PerlInterpMaxRequests", interp_max_requests,
"Max number of requests per Perl interpreters"),
-MP_DIR_CMD_TAKE1("PerlInterpLifetime", interp_lifetime,
+MP_CMD_DIR_TAKE1("PerlInterpLifetime", interp_lifetime,
"Lifetime of a Perl interpreter"),
#endif
MP_CMD_ENTRIES,
1.28 +1 -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.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- mod_perl.h2001/03/16 04:58:58 1.27
+++ mod_perl.h2001/03/16 05:52:29 1.28
@@ -16,6 +16,7 @@
#include "modperl_types.h"
#include "modperl_util.h"
#include "modperl_config.h"
+#include "modperl_cmd.h"
#include "modperl_handler.h"
#include "modperl_callback.h"
#include "modperl_tipool.h"
1.26 +2 -147modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- modperl_config.c 2001/03/16 05:32:35 1.25
+++ modperl_config.c 2001/03/16 05:52:29 1.26
@@ -1,23 +1,5 @@
#include "mod_perl.h"
-char *modperl_cmd_push_handlers(MpAV **handlers, const char *name,
-apr_pool_t *p)
-{
-modperl_handler_t *h = modperl_handler_new(p, name);
-
-if (!*
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_handler.c modperl_handler.h
dougm 01/03/15 22:32:15
Modified:lib/ModPerl Code.pm
src/modules/perl modperl_callback.c modperl_handler.c
modperl_handler.h
Log:
move some code into modperl_handler_lookup_handlers() so it can be reused for
{get,set,push}_handlers
Revision ChangesPath
1.49 +1 -1 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.48
retrieving revision 1.49
diff -u -r1.48 -r1.49
--- Code.pm 2001/03/16 05:52:28 1.48
+++ Code.pm 2001/03/16 06:32:14 1.49
@@ -113,7 +113,7 @@
my($self, $h_add, $c_add) = @_;
local $" = ",\n";
while (my($class, $h) = each %{ $self-{handler_index_desc} }) {
-my $func = canon_func($class, 'handler', 'desc');
+my $func = canon_func('handler', 'desc', $class);
my $array = join '_', 'MP', $func;
my $proto = "const char *$func(int idx)";
1.32 +2 -22 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- modperl_callback.c2001/03/16 05:08:15 1.31
+++ modperl_callback.c2001/03/16 06:32:15 1.32
@@ -114,28 +114,8 @@
return DECLINED;
}
-switch (type) {
- case MP_HANDLER_TYPE_PER_DIR:
-av = dcfg-handlers[idx];
-MP_TRACE_a_do(desc = modperl_per_dir_handler_desc(idx));
-break;
- case MP_HANDLER_TYPE_PER_SRV:
-av = scfg-handlers[idx];
-MP_TRACE_a_do(desc = modperl_per_srv_handler_desc(idx));
-break;
- case MP_HANDLER_TYPE_CONNECTION:
-av = scfg-connection_cfg-handlers[idx];
-MP_TRACE_a_do(desc = modperl_connection_handler_desc(idx));
-break;
- case MP_HANDLER_TYPE_FILES:
-av = scfg-files_cfg-handlers[idx];
-MP_TRACE_a_do(desc = modperl_files_handler_desc(idx));
-break;
- case MP_HANDLER_TYPE_PROCESS:
-av = scfg-process_cfg-handlers[idx];
-MP_TRACE_a_do(desc = modperl_process_handler_desc(idx));
-break;
-};
+av = modperl_handler_lookup_handlers(dcfg, scfg, NULL,
+ type, idx, desc);
if (!av) {
MP_TRACE_h(MP_FUNC, "no %s handlers configured (%s)\n",
1.2 +37 -0 modperl-2.0/src/modules/perl/modperl_handler.c
Index: modperl_handler.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_handler.c 2001/03/16 04:58:59 1.1
+++ modperl_handler.c 2001/03/16 06:32:15 1.2
@@ -60,3 +60,40 @@
va_end(args);
}
+
+#define set_desc(dtype) \
+MP_TRACE_a_do(if (desc) *desc = modperl_handler_desc_##dtype(idx))
+
+MpAV *modperl_handler_lookup_handlers(modperl_config_dir_t *dcfg,
+ modperl_config_srv_t *scfg,
+ modperl_config_req_t *rcfg,
+ int type, int idx,
+ const char **desc)
+{
+MpAV *av = NULL;
+
+switch (type) {
+ case MP_HANDLER_TYPE_PER_DIR:
+av = dcfg-handlers[idx];
+set_desc(per_dir);
+break;
+ case MP_HANDLER_TYPE_PER_SRV:
+av = scfg-handlers[idx];
+set_desc(per_srv);
+break;
+ case MP_HANDLER_TYPE_CONNECTION:
+av = scfg-connection_cfg-handlers[idx];
+set_desc(connection);
+break;
+ case MP_HANDLER_TYPE_FILES:
+av = scfg-files_cfg-handlers[idx];
+set_desc(files);
+break;
+ case MP_HANDLER_TYPE_PROCESS:
+av = scfg-process_cfg-handlers[idx];
+set_desc(process);
+break;
+};
+
+return av;
+}
1.2 +5 -0 modperl-2.0/src/modules/perl/modperl_handler.h
Index: modperl_handler.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_handler.h 2001/03/16 04:58:59 1.1
+++ modperl_handler.h 2001/03/16 06:32:15 1.2
@@ -8,5 +8,10 @@
void modperl_handler_make_args(pTHX_ AV **avp, ...);
+MpAV *modperl_handler_lookup_handlers(modperl_config_dir_t *dcfg,
+
cvs commit: modperl-2.0/src/modules/perl modperl_config.h
dougm 01/03/15 22:35:18 Modified:src/modules/perl modperl_config.h Log: allow modperl_config_req_get() to not core-dump if r == NULL Revision ChangesPath 1.23 +2 -2 modperl-2.0/src/modules/perl/modperl_config.h Index: modperl_config.h === RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v retrieving revision 1.22 retrieving revision 1.23 diff -u -r1.22 -r1.23 --- modperl_config.h 2001/03/16 05:52:29 1.22 +++ modperl_config.h 2001/03/16 06:35:18 1.23 @@ -27,8 +27,8 @@ } #define modperl_config_req_get(r) \ - (modperl_config_req_t *) \ - ap_get_module_config(r-request_config, perl_module) + (r ? (modperl_config_req_t *) \ + ap_get_module_config(r-request_config, perl_module) : NULL) #define MP_dRCFG \ modperl_config_req_t *rcfg = modperl_config_req_get(r)
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_handler.c modperl_handler.h
dougm 01/03/15 22:41:46
Modified:src/modules/perl modperl_callback.c modperl_handler.c
modperl_handler.h
Log:
need to return the address incase caller needs to initialize (e.g. push/set)
Revision ChangesPath
1.33 +4 -4 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- modperl_callback.c2001/03/16 06:32:15 1.32
+++ modperl_callback.c2001/03/16 06:41:46 1.33
@@ -102,7 +102,7 @@
MP_dDCFG;
modperl_handler_t **handlers;
apr_pool_t *p = NULL;
-MpAV *av = NULL;
+MpAV *av, **avp;
int i, status = OK;
const char *desc = NULL;
va_list args;
@@ -114,10 +114,10 @@
return DECLINED;
}
-av = modperl_handler_lookup_handlers(dcfg, scfg, NULL,
- type, idx, desc);
+avp = modperl_handler_lookup_handlers(dcfg, scfg, NULL,
+ type, idx, desc);
-if (!av) {
+if (!(avp (av = *avp))) {
MP_TRACE_h(MP_FUNC, "no %s handlers configured (%s)\n",
desc, r ? r-uri : "");
return DECLINED;
1.3 +6 -6 modperl-2.0/src/modules/perl/modperl_handler.c
Index: modperl_handler.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_handler.c 2001/03/16 06:32:15 1.2
+++ modperl_handler.c 2001/03/16 06:41:46 1.3
@@ -64,11 +64,11 @@
#define set_desc(dtype) \
MP_TRACE_a_do(if (desc) *desc = modperl_handler_desc_##dtype(idx))
-MpAV *modperl_handler_lookup_handlers(modperl_config_dir_t *dcfg,
- modperl_config_srv_t *scfg,
- modperl_config_req_t *rcfg,
- int type, int idx,
- const char **desc)
+MpAV **modperl_handler_lookup_handlers(modperl_config_dir_t *dcfg,
+ modperl_config_srv_t *scfg,
+ modperl_config_req_t *rcfg,
+ int type, int idx,
+ const char **desc)
{
MpAV *av = NULL;
@@ -95,5 +95,5 @@
break;
};
-return av;
+return av ? av : NULL;
}
1.3 +5 -5 modperl-2.0/src/modules/perl/modperl_handler.h
Index: modperl_handler.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_handler.h 2001/03/16 06:32:15 1.2
+++ modperl_handler.h 2001/03/16 06:41:46 1.3
@@ -8,10 +8,10 @@
void modperl_handler_make_args(pTHX_ AV **avp, ...);
-MpAV *modperl_handler_lookup_handlers(modperl_config_dir_t *dcfg,
- modperl_config_srv_t *scfg,
- modperl_config_req_t *rcfg,
- int type, int idx,
- const char **desc);
+MpAV **modperl_handler_lookup_handlers(modperl_config_dir_t *dcfg,
+ modperl_config_srv_t *scfg,
+ modperl_config_req_t *rcfg,
+ int type, int idx,
+ const char **desc);
#endif /* MODPERL_HANDLER_H */
cvs commit: modperl-2.0/src/modules/perl modperl_config.c modperl_filter.c modperl_handler.c modperl_mgv.c modperl_types.h
dougm 01/03/15 23:30:25
Modified:lib/ModPerl Code.pm
src/modules/perl modperl_config.c modperl_filter.c
modperl_handler.c modperl_mgv.c modperl_types.h
Log:
no need for modperl_{files,process,connection}_config_t
Revision ChangesPath
1.50 +6 -4 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.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- Code.pm 2001/03/16 06:32:14 1.49
+++ Code.pm 2001/03/16 07:30:21 1.50
@@ -71,8 +71,7 @@
);
for my $class (qw(Process Connection Files)) {
-my $lc_class = lc $class;
-$directive_proto{$class}-{cfg}-{name} = "scfg-${lc_class}_cfg";
+$directive_proto{$class}-{cfg}-{name} = 'scfg';
$directive_proto{$class}-{cfg}-{get} = $scfg_get;
for (qw(args scope)) {
@@ -82,6 +81,9 @@
while (my($k,$v) = each %directive_proto) {
$directive_proto{$k}-{ret} = 'const char *';
+my $handlers = join '_', 'handlers', canon_lc($k);
+$directive_proto{$k}-{handlers} =
+ join '-', $directive_proto{$k}-{cfg}-{name}, $handlers;
}
#XXX: allow disabling of PerDir hooks on a PerDir basis
@@ -144,7 +146,7 @@
my $handler_type = canon_define('HANDLER_TYPE', $class);
print $h_fh "\n#define ",
- canon_define($class, 'num_handlers'), " $n\n\n";
+ canon_define('HANDLER_NUM', $class), " $n\n\n";
print $h_fh "#define $handler_type $type\n\n";
@@ -271,7 +273,7 @@
my $protostr = canon_proto($prototype, $name);
my $flag = 'MpSrv' . canon_uc($h);
my $ix = $self-{handler_index}-{$class}-[$i++];
-my $av = "$prototype-{cfg}-{name}-handlers[$ix]";
+my $av = "$prototype-{handlers} [$ix]";
print $h_fh "$protostr;\n";
1.27 +13 -22modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- modperl_config.c 2001/03/16 05:52:29 1.26
+++ modperl_config.c 2001/03/16 07:30:22 1.27
@@ -32,8 +32,8 @@
{ /* XXX: should do a proper merge of the arrays */
/* XXX: and check if Perl*Handler is disabled */
int i;
-for (i=0; iMP_PER_DIR_NUM_HANDLERS; i++) {
-merge_item(handlers[i]);
+for (i=0; i MP_HANDLER_NUM_PER_DIR; i++) {
+merge_item(handlers_per_dir[i]);
}
}
@@ -63,21 +63,6 @@
modperl_config_srv_argv_push((char *)ap_server_argv0);
-#ifdef MP_CONNECTION_NUM_HANDLERS
-scfg-connection_cfg = (modperl_connection_config_t *)
-apr_pcalloc(p, sizeof(*scfg-connection_cfg));
-#endif
-
-#ifdef MP_FILES_NUM_HANDLERS
-scfg-files_cfg = (modperl_files_config_t *)
-apr_pcalloc(p, sizeof(*scfg-files_cfg));
-#endif
-
-#ifdef MP_PROCESS_NUM_HANDLERS
-scfg-process_cfg = (modperl_process_config_t *)
-apr_pcalloc(p, sizeof(*scfg-process_cfg));
-#endif
-
MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)scfg);
return scfg;
@@ -161,15 +146,21 @@
#endif
merge_item(argv);
-merge_item(files_cfg);
-merge_item(process_cfg);
-merge_item(connection_cfg);
{ /* XXX: should do a proper merge of the arrays */
/* XXX: and check if Perl*Handler is disabled */
int i;
-for (i=0; iMP_PER_SRV_NUM_HANDLERS; i++) {
-merge_item(handlers[i]);
+for (i=0; i MP_HANDLER_NUM_PER_SRV; i++) {
+merge_item(handlers_per_srv[i]);
+}
+for (i=0; i MP_HANDLER_NUM_FILES; i++) {
+merge_item(handlers_files[i]);
+}
+for (i=0; i MP_HANDLER_NUM_PROCESS; i++) {
+merge_item(handlers_process[i]);
+}
+for (i=0; i MP_HANDLER_NUM_CONNECTION; i++) {
+merge_item(handlers_connection[i]);
}
}
1.10 +1 -1 modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- modperl_filter.c 2001/03/15 05:39:07 1.9
+++ modperl_filter.c 2001/03/16 07:30:22 1.10
@@ -336,7 +336,7 @@
MP_dDCFG;
MpAV *av;
-if ((av = dcfg-handlers[MP_
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_config.c modperl_config.h modperl_interp.c modperl_types.h
dougm 01/03/14 00:22:51
Modified:src/modules/perl mod_perl.c modperl_config.c
modperl_config.h modperl_interp.c modperl_types.h
Log:
allow PerlInterpLifetime to be per-dir for subrequest and request lifetime
Revision ChangesPath
1.32 +3 -3 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.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- mod_perl.c2001/03/14 05:22:49 1.31
+++ mod_perl.c2001/03/14 08:22:47 1.32
@@ -129,7 +129,7 @@
char *name = modperl_server_desc(s, p);
MP_TRACE_i(MP_FUNC, "PerlInterpLifetime set to %s for %s\n",
- modperl_interp_lifetime_desc(scfg), name);
+ modperl_interp_lifetime_desc(scfg-interp_lifetime), name);
#endif /* MP_TRACE */
if (scfg-mip-tipool-idle) {
@@ -220,8 +220,8 @@
"Min number of spare Perl interpreters"),
MP_SRV_CMD_TAKE1("PerlInterpMaxRequests", interp_max_requests,
"Max number of requests per Perl interpreters"),
-MP_SRV_CMD_TAKE1("PerlInterpLifetime", interp_lifetime,
- "Lifetime of a Perl interpreter (connection or request)"),
+MP_DIR_CMD_TAKE1("PerlInterpLifetime", interp_lifetime,
+ "Lifetime of a Perl interpreter"),
#endif
MP_CMD_ENTRIES,
{ NULL },
1.20 +32 -7 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_config.c 2001/03/14 05:22:49 1.19
+++ modperl_config.c 2001/03/14 08:22:48 1.20
@@ -21,6 +21,12 @@
void *modperl_create_dir_config(apr_pool_t *p, char *dir)
{
modperl_dir_config_t *dcfg = modperl_dir_config_new(p);
+
+#ifdef USE_ITHREADS
+/* defaults to per-server lifetime */
+dcfg-interp_lifetime = MP_INTERP_LIFETIME_UNDEF;
+#endif
+
return dcfg;
}
@@ -226,31 +232,50 @@
#ifdef USE_ITHREADS
static const char *MP_interp_lifetime_desc[] = {
-"none", "request", "connection",
+"undef", "subrequest", "request", "connection",
};
-const char *modperl_interp_lifetime_desc(modperl_srv_config_t *scfg)
+const char *modperl_interp_lifetime_desc(modperl_interp_lifetime_e lifetime)
{
-return MP_interp_lifetime_desc[scfg-interp_lifetime];
+return MP_interp_lifetime_desc[lifetime];
}
+#define MP_INTERP_LIFETIME_OPTS "PerlInterpLifetime must be one of "
+
+#define MP_INTERP_LIFETIME_DIR_OPTS \
+MP_INTERP_LIFETIME_OPTS "subrequest or request"
+
+#define MP_INTERP_LIFETIME_SRV_OPTS \
+MP_INTERP_LIFETIME_OPTS "subrequest, request or connection"
+
MP_DECLARE_SRV_CMD(interp_lifetime)
{
+modperl_interp_lifetime_e *lifetime;
+modperl_dir_config_t *dcfg = (modperl_dir_config_t *)dummy;
MP_dSCFG(parms-server);
+int is_per_dir = parms-path ? 1 : 0;
+
+lifetime = is_per_dir ? dcfg-interp_lifetime : scfg-interp_lifetime;
switch (toLOWER(*arg)) {
+ case 's':
+if (strcaseEQ(arg, "subrequest")) {
+*lifetime = MP_INTERP_LIFETIME_SUBREQUEST;
+break;
+}
case 'r':
if (strcaseEQ(arg, "request")) {
-scfg-interp_lifetime = MP_INTERP_LIFETIME_REQUEST;
+*lifetime = MP_INTERP_LIFETIME_REQUEST;
break;
}
case 'c':
-if (strcaseEQ(arg, "connection")) {
-scfg-interp_lifetime = MP_INTERP_LIFETIME_CONNECTION;
+if (!is_per_dir strcaseEQ(arg, "connection")) {
+*lifetime = MP_INTERP_LIFETIME_CONNECTION;
break;
}
default:
-return "PerlInterpLifetime must be one of connection or request";
+return is_per_dir ?
+MP_INTERP_LIFETIME_DIR_OPTS : MP_INTERP_LIFETIME_SRV_OPTS;
};
return NULL;
1.19 +13 -3 modperl-2.0/src/modules/perl/modperl_config.h
Index: modperl_config.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- modperl_config.h 2001/03/14 05:22:49 1.18
+++ modperl_confi
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_callback.h
dougm 01/03/14 09:28:07
Modified:src/modules/perl modperl_callback.c modperl_callback.h
Log:
canonicalize MP_HANDLER_TYPE_ names
Revision ChangesPath
1.26 +17 -15modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- modperl_callback.c2001/03/14 05:22:49 1.25
+++ modperl_callback.c2001/03/14 17:28:07 1.26
@@ -173,23 +173,23 @@
}
switch (type) {
- case MP_HANDLER_TYPE_DIR:
+ case MP_HANDLER_TYPE_PER_DIR:
av = dcfg-handlers[idx];
MP_TRACE_a_do(desc = modperl_per_dir_handler_desc(idx));
break;
- case MP_HANDLER_TYPE_SRV:
+ case MP_HANDLER_TYPE_PER_SRV:
av = scfg-handlers[idx];
MP_TRACE_a_do(desc = modperl_per_srv_handler_desc(idx));
break;
- case MP_HANDLER_TYPE_CONN:
+ case MP_HANDLER_TYPE_CONNECTION:
av = scfg-connection_cfg-handlers[idx];
MP_TRACE_a_do(desc = modperl_connection_handler_desc(idx));
break;
- case MP_HANDLER_TYPE_FILE:
+ case MP_HANDLER_TYPE_FILES:
av = scfg-files_cfg-handlers[idx];
MP_TRACE_a_do(desc = modperl_files_handler_desc(idx));
break;
- case MP_HANDLER_TYPE_PROC:
+ case MP_HANDLER_TYPE_PROCESS:
av = scfg-process_cfg-handlers[idx];
MP_TRACE_a_do(desc = modperl_process_handler_desc(idx));
break;
@@ -222,16 +222,16 @@
handlers = (modperl_handler_t **)av-elts;
switch (type) {
- case MP_HANDLER_TYPE_DIR:
- case MP_HANDLER_TYPE_SRV:
+ case MP_HANDLER_TYPE_PER_DIR:
+ case MP_HANDLER_TYPE_PER_SRV:
modperl_handler_make_args(aTHX_ av_args,
"Apache::RequestRec", r, NULL);
break;
- case MP_HANDLER_TYPE_CONN:
+ case MP_HANDLER_TYPE_CONNECTION:
modperl_handler_make_args(aTHX_ av_args,
"Apache::Connection", c, NULL);
break;
- case MP_HANDLER_TYPE_FILE:
+ case MP_HANDLER_TYPE_FILES:
{
apr_pool_t *pconf, *plog, *ptemp;
@@ -248,7 +248,7 @@
"Apache::Server", s, NULL);
}
break;
- case MP_HANDLER_TYPE_PROC:
+ case MP_HANDLER_TYPE_PROCESS:
{
apr_pool_t *pconf;
@@ -292,29 +292,31 @@
int modperl_per_dir_callback(int idx, request_rec *r)
{
-return modperl_run_handlers(idx, r, NULL, r-server, MP_HANDLER_TYPE_DIR);
+return modperl_run_handlers(idx, r, NULL, r-server,
+MP_HANDLER_TYPE_PER_DIR);
}
int modperl_per_srv_callback(int idx, request_rec *r)
{
-return modperl_run_handlers(idx, r, NULL, r-server, MP_HANDLER_TYPE_SRV);
+return modperl_run_handlers(idx, r, NULL, r-server,
+MP_HANDLER_TYPE_PER_SRV);
}
int modperl_connection_callback(int idx, conn_rec *c)
{
return modperl_run_handlers(idx, NULL, c, c-base_server,
-MP_HANDLER_TYPE_CONN);
+MP_HANDLER_TYPE_CONNECTION);
}
void modperl_process_callback(int idx, apr_pool_t *p, server_rec *s)
{
-modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_PROC, p);
+modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_PROCESS, p);
}
void modperl_files_callback(int idx,
apr_pool_t *pconf, apr_pool_t *plog,
apr_pool_t *ptemp, server_rec *s)
{
-modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_FILE,
+modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_FILES,
pconf, plog, ptemp);
}
1.13 +5 -5 modperl-2.0/src/modules/perl/modperl_callback.h
Index: modperl_callback.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- modperl_callback.h2001/03/14 00:37:52 1.12
+++ modperl_callback.h2001/03/14 17:28:07 1.13
@@ -10,11 +10,11 @@
#define ap_hook_fixup ap_hook_fixups
#define ap_hook_logap_hook_log_transaction
-#define MP_HANDLER_TYPE_DIR 1
-#define MP_HANDLER_TYPE_SRV 2
-#define MP_HANDLER_TYPE_CONN 3
-#define MP_HANDLER_TYPE_PROC 4
-#define MP_HANDLER_TYPE_FILE 5
+#define MP_HANDLER_TYPE_PER_DIR1
+#define MP_HANDLE
cvs commit: modperl-2.0/src/modules/perl modperl_mgv.c modperl_perl_includes.h
dougm 01/03/14 17:26:18
Modified:src/modules/perl modperl_mgv.c modperl_perl_includes.h
Log:
fixes to compile with non-ithreads 5.6.0 Perl
Revision ChangesPath
1.2 +3 -1 modperl-2.0/src/modules/perl/modperl_mgv.c
Index: modperl_mgv.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_mgv.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_mgv.c 2001/03/09 23:42:04 1.1
+++ modperl_mgv.c 2001/03/15 01:26:18 1.2
@@ -205,7 +205,7 @@
else {
if ((cv = get_cv(name, FALSE))) {
handler-mgv_cv =
-modperl_mgv_compile(aTHX, p, HvNAME(GvSTASH(CvGV(cv;
+modperl_mgv_compile(aTHX_ p, HvNAME(GvSTASH(CvGV(cv;
modperl_mgv_append(aTHX_ p, handler-mgv_cv, GvNAME(CvGV(cv)));
MpHandlerPARSED_On(handler);
return 1;
@@ -312,8 +312,10 @@
static int modperl_dw_hash_handlers(apr_pool_t *p, server_rec *s,
void *cfg, char *d, void *data)
{
+#ifdef USE_ITHREADS
MP_dSCFG(s);
MP_dSCFG_dTHX;
+#endif
int i;
modperl_dir_config_t *dir_cfg = (modperl_dir_config_t *)cfg;
1.4 +4 -0 modperl-2.0/src/modules/perl/modperl_perl_includes.h
Index: modperl_perl_includes.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_includes.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_perl_includes.h 2001/01/21 18:19:56 1.3
+++ modperl_perl_includes.h 2001/03/15 01:26:18 1.4
@@ -39,4 +39,8 @@
#undef dNOOP
#define dNOOP extern int __attribute__ ((unused)) Perl___notused
+#ifndef G_METHOD
+# define G_METHOD 64
+#endif
+
#endif /* MODPERL_PERL_INCLUDES_H */
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_gtop.c modperl_gtop.h
dougm 01/03/14 17:55:44
Modified:src/modules/perl mod_perl.c modperl_gtop.c modperl_gtop.h
Log:
fixes to compile without MP_TRACE
Revision ChangesPath
1.34 +2 -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.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- mod_perl.c2001/03/15 01:47:00 1.33
+++ mod_perl.c2001/03/15 01:55:44 1.34
@@ -151,6 +151,8 @@
MP_TRACE_i(MP_FUNC, "PerlInterpLifetime set to %s for %s\n",
modperl_interp_lifetime_desc(scfg-interp_lifetime), name);
+#else
+char *name = NULL;
#endif /* MP_TRACE */
if (scfg-mip-tipool-idle) {
1.7 +2 -2 modperl-2.0/src/modules/perl/modperl_gtop.c
Index: modperl_gtop.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_gtop.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_gtop.c2001/03/04 18:49:38 1.6
+++ modperl_gtop.c2001/03/15 01:55:44 1.7
@@ -1,6 +1,6 @@
-#ifdef MP_USE_GTOP
-
#include "mod_perl.h"
+
+#ifdef MP_USE_GTOP
static int modperl_gtop_size_string(size_t size, char *size_string)
{
1.3 +4 -0 modperl-2.0/src/modules/perl/modperl_gtop.h
Index: modperl_gtop.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_gtop.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_gtop.h2000/08/14 03:10:45 1.2
+++ modperl_gtop.h2001/03/15 01:55:44 1.3
@@ -1,6 +1,10 @@
#ifndef MODPERL_GTOP_H
#define MODPERL_GTOP_H
+#ifndef MP_TRACE
+#undef MP_USE_GTOP
+#endif
+
#ifdef MP_USE_GTOP
#include glibtop.h
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_interp.c
dougm 01/03/14 20:34:04
Modified:src/modules/perl mod_perl.c modperl_interp.c
Log:
need to PERL_SET_CONTEXT to parent perl in non-threaded mpms
give a little more trace info about interpreters in virtual hosts
Revision ChangesPath
1.36 +3 -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.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- mod_perl.c2001/03/15 02:17:35 1.35
+++ mod_perl.c2001/03/15 04:34:04 1.36
@@ -98,8 +98,9 @@
/* if alloc flags is On, virtual host gets its own parent perl */
if (MpSrvPARENT(scfg)) {
perl = modperl_startup(s, p);
-MP_TRACE_i(MP_FUNC, "modperl_startup() server=%s\n",
- s-server_hostname);
+MP_TRACE_i(MP_FUNC,
+ "created parent interpreter for VirtualHost %s\n",
+ modperl_server_desc(s, p));
}
#ifdef USE_ITHREADS
1.24 +6 -2 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.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- modperl_interp.c 2001/03/15 02:17:35 1.23
+++ modperl_interp.c 2001/03/15 04:34:04 1.24
@@ -215,8 +215,12 @@
modperl_interp_lifetime_e lifetime;
if (!scfg-threaded_mpm) {
-MP_TRACE_i(MP_FUNC, "using parent 0x%lx for non-threaded mpm\n",
- (unsigned long)scfg-mip-parent);
+MP_TRACE_i(MP_FUNC,
+ "using parent 0x%lx for non-threaded mpm (%s:%d)\n",
+ (unsigned long)scfg-mip-parent,
+ s-server_hostname, s-port);
+/* XXX: if no VirtualHosts w/ PerlOptions +Parent we can skip this */
+PERL_SET_CONTEXT(scfg-mip-parent-perl);
return scfg-mip-parent;
}
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_config.c modperl_config.h modperl_interp.c modperl_types.h
dougm 01/03/14 23:04:41
Modified:src/modules/perl modperl_callback.c modperl_config.c
modperl_config.h modperl_interp.c modperl_types.h
Log:
support "PerlInterpLifetime handler"
Revision ChangesPath
1.29 +3 -5 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- modperl_callback.c2001/03/15 05:42:15 1.28
+++ modperl_callback.c2001/03/15 07:04:41 1.29
@@ -282,11 +282,9 @@
SvREFCNT_dec((SV*)av_args);
#ifdef USE_ITHREADS
-if (interp MpInterpPUTBACK_On(interp)) {
-/* XXX: might want to put interp back into available pool
- * rather than have it marked as in_use for the lifetime of
- * a request
- */
+if (interp MpInterpPUTBACK(interp)) {
+/* PerlInterpLifetime handler */
+modperl_interp_unselect(interp);
}
#endif
1.22 +16 -5 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- modperl_config.c 2001/03/15 02:17:35 1.21
+++ modperl_config.c 2001/03/15 07:04:41 1.22
@@ -234,7 +234,7 @@
#ifdef USE_ITHREADS
static const char *MP_interp_lifetime_desc[] = {
-"undef", "subrequest", "request", "connection",
+"undef", "handler", "subrequest", "request", "connection",
};
const char *modperl_interp_lifetime_desc(modperl_interp_lifetime_e lifetime)
@@ -242,14 +242,20 @@
return MP_interp_lifetime_desc[lifetime];
}
-#define MP_INTERP_LIFETIME_OPTS "PerlInterpLifetime must be one of "
+#define MP_INTERP_LIFETIME_USAGE "PerlInterpLifetime must be one of "
#define MP_INTERP_LIFETIME_DIR_OPTS \
-MP_INTERP_LIFETIME_OPTS "subrequest or request"
+"handler, subrequest or request"
+#define MP_INTERP_LIFETIME_DIR_USAGE \
+MP_INTERP_LIFETIME_USAGE MP_INTERP_LIFETIME_DIR_OPTS
+
#define MP_INTERP_LIFETIME_SRV_OPTS \
-MP_INTERP_LIFETIME_OPTS "subrequest, request or connection"
+"connection, " MP_INTERP_LIFETIME_DIR_OPTS
+#define MP_INTERP_LIFETIME_SRV_USAGE \
+MP_INTERP_LIFETIME_USAGE MP_INTERP_LIFETIME_SRV_OPTS
+
MP_DECLARE_SRV_CMD(interp_lifetime)
{
modperl_interp_lifetime_e *lifetime;
@@ -260,6 +266,11 @@
lifetime = is_per_dir ? dcfg-interp_lifetime : scfg-interp_lifetime;
switch (toLOWER(*arg)) {
+ case 'h':
+if (strcaseEQ(arg, "handler")) {
+*lifetime = MP_INTERP_LIFETIME_HANDLER;
+break;
+}
case 's':
if (strcaseEQ(arg, "subrequest")) {
*lifetime = MP_INTERP_LIFETIME_SUBREQUEST;
@@ -277,7 +288,7 @@
}
default:
return is_per_dir ?
-MP_INTERP_LIFETIME_DIR_OPTS : MP_INTERP_LIFETIME_SRV_OPTS;
+MP_INTERP_LIFETIME_DIR_USAGE : MP_INTERP_LIFETIME_SRV_USAGE;
};
return NULL;
1.20 +3 -0 modperl-2.0/src/modules/perl/modperl_config.h
Index: modperl_config.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- modperl_config.h 2001/03/14 08:22:48 1.19
+++ modperl_config.h 2001/03/15 07:04:41 1.20
@@ -40,6 +40,9 @@
#define modperl_interp_lifetime_undef(dcfg) \
(dcfg-interp_lifetime == MP_INTERP_LIFETIME_UNDEF)
+#define modperl_interp_lifetime_handler(dcfg) \
+(dcfg-interp_lifetime == MP_INTERP_LIFETIME_HANDLER)
+
#define modperl_interp_lifetime_subrequest(dcfg) \
(dcfg-interp_lifetime == MP_INTERP_LIFETIME_SUBREQUEST)
1.25 +25 -14modperl-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.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- modperl_interp.c 2001/03/15 04:34:04 1.24
+++ modperl_interp.c 2001/03/15 07:04:41 1.25
@@ -189,6 +189,7 @@
modperl_interp_pool_t *mip = interp-mip;
MpInterpIN_USE_Off(interp);
+MpInterpPUTBACK_Off(interp);
modperl_tipool_putba
cvs commit: modperl-2.0/src/modules/perl modperl_config.c
dougm 01/03/14 23:21:14
Modified:src/modules/perl modperl_config.c
Log:
make per-dir merger do something more useful
Revision ChangesPath
1.24 +16 -6 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- modperl_config.c 2001/03/15 07:11:36 1.23
+++ modperl_config.c 2001/03/15 07:21:14 1.24
@@ -30,19 +30,32 @@
return dcfg;
}
+#define merge_item(item) \
+mrg-item = add-item ? add-item : base-item
+
void *modperl_merge_dir_config(apr_pool_t *p, void *basev, void *addv)
{
-#if 0
modperl_dir_config_t
*base = (modperl_dir_config_t *)basev,
*add = (modperl_dir_config_t *)addv,
*mrg = modperl_dir_config_new(p);
-#endif
MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
(unsigned long)basev, (unsigned long)addv);
+
+#ifdef USE_ITHREADS
+merge_item(interp_lifetime);
+#endif
+
+{ /* XXX: should do a proper merge of the arrays */
+ /* XXX: and check if Perl*Handler is disabled */
+int i;
+for (i=0; iMP_PER_DIR_NUM_HANDLERS; i++) {
+merge_item(handlers[i]);
+}
+}
-return addv;
+return mrg;
}
modperl_request_config_t *modperl_request_config_new(request_rec *r)
@@ -147,9 +160,6 @@
return scfg;
}
-
-#define merge_item(item) \
-mrg-item = add-item ? add-item : base-item
/* XXX: this is not complete */
void *modperl_merge_srv_config(apr_pool_t *p, void *basev, void *addv)
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_util.c modperl_util.h
dougm 01/03/13 20:22:51
Modified:src/modules/perl mod_perl.c modperl_util.c modperl_util.h
Log:
add modperl_server_desc() function
add more trace details when initializing the interpreter pool
Revision ChangesPath
1.30 +25 -6 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.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- mod_perl.c2001/03/09 23:46:34 1.29
+++ mod_perl.c2001/03/14 04:22:51 1.30
@@ -93,7 +93,7 @@
*/
if (MpSrvPARENT(scfg) || MpSrvCLONE(scfg)) {
MP_TRACE_i(MP_FUNC, "modperl_interp_init() server=%s\n",
- s-server_hostname);
+ modperl_server_desc(s, p));
modperl_interp_init(s, p, perl);
}
@@ -118,20 +118,39 @@
#ifdef USE_ITHREADS
static void modperl_init_clones(server_rec *s, apr_pool_t *p)
{
+#ifdef MP_TRACE
+modperl_srv_config_t *base_scfg = modperl_srv_config_get(s);
+char *base_name = modperl_server_desc(s, p);
+#endif /* MP_TRACE */
+
for (; s; s=s-next) {
MP_dSCFG(s);
+#ifdef MP_TRACE
+char *name = modperl_server_desc(s, p);
+#endif /* MP_TRACE */
+
if (scfg-mip-tipool-idle) {
-MP_TRACE_i(MP_FUNC, "%s interp already cloned\n",
- s-server_hostname);
+#ifdef MP_TRACE
+if (scfg-mip == base_scfg-mip) {
+MP_TRACE_i(MP_FUNC,
+ "%s interp pool inherited from %s\n",
+ name, base_name);
+}
+else {
+MP_TRACE_i(MP_FUNC,
+ "%s interp pool already initialized\n",
+ name);
+}
+#endif /* MP_TRACE */
}
else {
-MP_TRACE_i(MP_FUNC, "cloning interp for %s\n",
- s-server_hostname);
+MP_TRACE_i(MP_FUNC, "initializing interp pool for %s\n",
+ name);
modperl_tipool_init(scfg-mip-tipool);
}
}
}
-#endif
+#endif /* USE_ITHREADS */
void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog,
apr_pool_t *ptemp, server_rec *s)
1.5 +5 -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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_util.c2001/03/13 05:09:02 1.4
+++ modperl_util.c2001/03/14 04:22:51 1.5
@@ -81,3 +81,8 @@
return status;
}
+
+char *modperl_server_desc(server_rec *s, apr_pool_t *p)
+{
+return apr_psprintf(p, "%s:%u", s-server_hostname, s-port);
+}
1.5 +2 -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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_util.h2001/03/09 23:46:36 1.4
+++ modperl_util.h2001/03/14 04:22:51 1.5
@@ -20,4 +20,6 @@
int modperl_require_module(pTHX_ const char *pv);
+char *modperl_server_desc(server_rec *s, apr_pool_t *p);
+
#endif /* MODPERL_UTIL_H */
cvs commit: modperl-2.0/src/modules/perl modperl_interp.c
dougm 01/03/13 22:57:44
Modified:src/modules/perl modperl_interp.c
Log:
share selected Perl interpreter across sub-requests by default
Revision ChangesPath
1.21 +10 -5 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.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- modperl_interp.c 2001/03/14 05:22:49 1.20
+++ modperl_interp.c 2001/03/14 06:57:43 1.21
@@ -202,12 +202,14 @@
*/
#define MP_INTERP_KEY "MODPERL_INTERP"
-modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
+modperl_interp_t *modperl_interp_select(request_rec *rr, conn_rec *c,
server_rec *s)
{
MP_dSCFG(s);
modperl_interp_t *interp;
apr_pool_t *p = NULL;
+int is_subrequest = (rr rr-main) ? 1 : 0;
+request_rec *r = is_subrequest ? rr-main : rr;
const char *desc = NULL;
int lifetime_connection =
(modperl_interp_lifetime_connection(scfg) || !r);
@@ -231,8 +233,9 @@
if (interp) {
MP_TRACE_i(MP_FUNC,
- "found interp 0x%lx in %s 0x%lx\n",
- (unsigned long)interp, desc, (unsigned long)r-pool);
+ "found interp 0x%lx in %s 0x%lx (%s request for %s)\n",
+ (unsigned long)interp, desc, (unsigned long)r-pool,
+ (is_subrequest ? "sub" : "main"), rr-uri);
return interp;
}
@@ -267,8 +270,10 @@
/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp-perl);
-MP_TRACE_i(MP_FUNC, "set interp 0x%lx in %s 0x%lx\n",
- (unsigned long)interp, desc, (unsigned long)p);
+MP_TRACE_i(MP_FUNC, "set interp 0x%lx in %s 0x%lx (%s request for %s)\n",
+ (unsigned long)interp, desc, (unsigned long)p,
+ (r ? (is_subrequest ? "sub" : "main") : "conn"),
+ (r ? rr-uri : c-remote_ip));
return interp;
}
cvs commit: modperl-2.0/xs/APR/Socket - New directory
dougm 01/03/12 21:24:20 modperl-2.0/xs/APR/Socket - New directory
cvs commit: modperl-2.0/xs/maps apache_functions.map
dougm 01/03/12 23:29:03
Modified:xs/Apache/Filter Apache__Filter.h
xs/maps apache_functions.map
Log:
add output filter "stream" interface read/print methods
Revision ChangesPath
1.2 +53 -0 modperl-2.0/xs/Apache/Filter/Apache__Filter.h
Index: Apache__Filter.h
===
RCS file: /home/cvs/modperl-2.0/xs/Apache/Filter/Apache__Filter.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Apache__Filter.h 2001/03/05 03:54:18 1.1
+++ Apache__Filter.h 2001/03/13 07:28:54 1.2
@@ -1,2 +1,55 @@
#define mpxs_Apache__RequestRec_add_output_filter(r, name, ctx) \
ap_add_output_filter(name, ctx, r, NULL)
+
+/* XXX: this should be generated like the others in modperl_xs_sv_convert.h */
+#define mp_xs_sv2_modperl_filter(sv) \
+((SvROK(sv) (SvTYPE(SvRV(sv)) == SVt_PVMG)) \
+|| (Perl_croak(aTHX_ "argument is not a blessed reference"),0) ? \
+(modperl_filter_t *)SvIV((SV*)SvRV(sv)) : (modperl_filter_t *)NULL)
+
+static MP_INLINE apr_size_t mpxs_Apache__OutputFilter_print(pTHX_ I32 items,
+SV **MARK, SV **SP)
+{
+modperl_filter_t *modperl_filter;
+apr_size_t bytes = 0;
+
+mpxs_usage_va_1(modperl_filter, "$filter-print(...)");
+
+if (modperl_filter-mode == MP_OUTPUT_FILTER_MODE) {
+mpxs_write_loop(modperl_output_filter_write, modperl_filter);
+modperl_output_filter_flush(modperl_filter);
+}
+else {
+croak("input filters not yet supported");
+}
+
+/* XXX: ap_rflush if $| */
+
+return bytes;
+}
+
+static MP_INLINE apr_size_t mpxs_Apache__OutputFilter_read(pTHX_ I32 items,
+ SV **MARK, SV **SP)
+{
+modperl_filter_t *modperl_filter;
+apr_size_t wanted, len=0;
+SV *buffer;
+
+mpxs_usage_va_2(modperl_filter, buffer, "$filter-read(buf, [len])");
+
+if (items 2) {
+wanted = SvIV(*MARK);
+}
+else {
+wanted = MP_IOBUFSIZE;
+}
+
+if (modperl_filter-mode == MP_OUTPUT_FILTER_MODE) {
+len = modperl_output_filter_read(aTHX_ modperl_filter, buffer, wanted);
+}
+else {
+croak("input filters not yet supported");
+}
+
+return len;
+}
1.3 +5 -1 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- apache_functions.map 2001/03/13 06:32:28 1.2
+++ apache_functions.map 2001/03/13 07:29:00 1.3
@@ -183,7 +183,11 @@
ap_filter_t *:DEFINE_add_output_filter | | \
request_rec *:r, const char *:name, void *:ctx
-MODULE=Apache::Filter PACKAGE=guess
+PACKAGE=Apache::OutputFilter
+ mpxs_Apache__OutputFilter_print | | ...
+ mpxs_Apache__OutputFilter_read | | ...
+
+PACKAGE=guess
~ap_add_output_filter
ap_add_input_filter
ap_get_brigade
cvs commit: modperl-2.0/xs/maps apache_functions.map
dougm 01/03/12 23:50:24
Modified:xs/Apache/RequestUtil Apache__RequestUtil.h
xs/maps apache_functions.map
Log:
the protocol module helpers are functions, not #defines
Revision ChangesPath
1.2 +10 -8 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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Apache__RequestUtil.h 2001/03/13 06:32:27 1.1
+++ Apache__RequestUtil.h 2001/03/13 07:50:19 1.2
@@ -3,8 +3,9 @@
* for protocol module helpers
*/
-static MP_INLINE request_rec *mpxs_Apache__RequestRec_new(SV *classname,
- conn_rec *c)
+static MP_INLINE
+request_rec *mpxs_Apache__RequestRec_new(SV *classname,
+ conn_rec *c)
{
apr_pool_t *p;
request_rec *r;
@@ -39,8 +40,9 @@
return r;
}
-static MP_INLINE int mpxs_Apache__RequestRec_location_merge(request_rec *r,
-char *location)
+static MP_INLINE
+int mpxs_Apache__RequestRec_location_merge(request_rec *r,
+ char *location)
{
apr_pool_t *p = r-pool;
server_rec *s = r-server;
@@ -71,10 +73,10 @@
return 0;
}
-static MP_INLINE void
-mpxs_Apache__RequestRec_set_basic_credentials(request_rec *r,
- char *username,
- char *password)
+static MP_INLINE
+void mpxs_Apache__RequestRec_set_basic_credentials(request_rec *r,
+ char *username,
+ char *password)
{
char encoded[1024];
int elen;
1.4 +3 -3 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.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- apache_functions.map 2001/03/13 07:29:00 1.3
+++ apache_functions.map 2001/03/13 07:50:22 1.4
@@ -46,10 +46,10 @@
ap_is_initial_req
#protocol module helpers
- int:DEFINE_location_merge | | request_rec *:r, char *:location
- void:DEFINE_set_basic_credentials | | request_rec *:r, char *:username, char
*:password
+ mpxs_Apache__RequestRec_location_merge
+ mpxs_Apache__RequestRec_set_basic_credentials
PACKAGE=Apache::RequestRec
- request_rec *:DEFINE_new | | SV *:classname, conn_rec *:c
+ mpxs_Apache__RequestRec_new
#MODULE=Apache::RequestConfig
ap_document_root
cvs commit: modperl-2.0/src/modules/perl modperl_mgv.c modperl_mgv.h
dougm 01/03/09 15:42:05
Added: src/modules/perl modperl_mgv.c modperl_mgv.h
Log:
module for pre-computing gv_fetchpv lookups of handlers
Revision ChangesPath
1.1 modperl-2.0/src/modules/perl/modperl_mgv.c
Index: modperl_mgv.c
===
#include "mod_perl.h"
/*
* mgv = ModPerl Glob Value || Mostly Glob Value
* as close to GV as we can get without actually using a GV
* need config structures to be free of Perl structures
*/
#define modperl_mgv_new_w_name(mgv, p, n, copy) \
mgv = modperl_mgv_new(p); \
mgv-len = strlen(n); \
mgv-name = (copy ? apr_pstrndup(p, n, mgv-len) : n)
#define modperl_mgv_new_name(mgv, p, n) \
modperl_mgv_new_w_name(mgv, p, n, 1)
#define modperl_mgv_new_namen(mgv, p, n) \
modperl_mgv_new_w_name(mgv, p, n, 0)
/*
* similar to hv_fetch_ent, but takes string key and key len rather than SV
* also skips magic and utf8 fu, since we are only dealing with symbol tables
*/
static HE *S_hv_fetch_he(pTHX_ HV *hv,
register char *key,
register I32 klen,
register U32 hash)
{
register XPVHV *xhv;
register HE *entry;
xhv = (XPVHV *)SvANY(hv);
entry = ((HE**)xhv-xhv_array)[hash (I32) xhv-xhv_max];
for (; entry; entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash)
continue;
if (HeKLEN(entry) != klen)
continue;
if (HeKEY(entry) != key memNE(HeKEY(entry),key,klen))
continue;
return entry;
}
return 0;
}
#define hv_fetch_he(hv,k,l,h) S_hv_fetch_he(aTHX_ hv,k,l,h)
modperl_mgv_t *modperl_mgv_new(apr_pool_t *p)
{
return (modperl_mgv_t *)apr_pcalloc(p, sizeof(modperl_mgv_t));
}
#define modperl_mgv_get_next(mgv) \
if (mgv-name) { \
mgv-next = modperl_mgv_new(p); \
mgv = mgv-next; \
}
#define modperl_mgv_hash(mgv) \
PERL_HASH(mgv-hash, mgv-name, mgv-len)
/* MP_TRACE_h(MP_FUNC, "%s...hash=%ld\n", mgv-name, mgv-hash) */
modperl_mgv_t *modperl_mgv_compile(pTHX_ apr_pool_t *p,
register const char *name)
{
register const char *namend;
I32 len;
modperl_mgv_t *symbol = modperl_mgv_new(p);
modperl_mgv_t *mgv = symbol;
/* @mgv = split '::', $name */
for (namend = name; *namend; namend++) {
if (*namend == ':' namend[1] == ':') {
if ((len = (namend - name)) 0) {
modperl_mgv_get_next(mgv);
mgv-name = apr_palloc(p, len+3);
Copy(name, mgv-name, len, char);
mgv-name[len++] = ':';
mgv-name[len++] = ':';
mgv-name[len] = '\0';
mgv-len = len;
modperl_mgv_hash(mgv);
}
name = namend + 2;
}
}
modperl_mgv_get_next(mgv);
mgv-len = namend - name;
mgv-name = apr_pstrndup(p, name, mgv-len);
modperl_mgv_hash(mgv);
return symbol;
}
void modperl_mgv_append(pTHX_ apr_pool_t *p, modperl_mgv_t *symbol,
const char *name)
{
modperl_mgv_t *mgv = symbol;
while (mgv-next) {
mgv = mgv-next;
}
mgv-name = apr_pstrcat(p, mgv-name, "::", NULL);
mgv-len += 2;
modperl_mgv_hash(mgv);
mgv-next = modperl_mgv_compile(aTHX_ p, name);
}
/* faster replacement for gv_fetchpv() */
GV *modperl_mgv_lookup(pTHX_ modperl_mgv_t *symbol)
{
HV *stash = PL_defstash;
modperl_mgv_t *mgv;
if (!symbol-hash) {
/* special case for MyClass-handler */
return (GV*)sv_2mortal(newSVpvn(symbol-name, symbol-len));
}
for (mgv = symbol; mgv; mgv = mgv-next) {
HE *he = hv_fetch_he(stash, mgv-name, mgv-len, mgv-hash);
if (he) {
if (mgv-next) {
stash = GvHV((GV *)HeVAL(he));
}
else {
return (GV *)HeVAL(he);
}
}
else {
return Nullgv;
}
}
return Nullgv;
}
int modperl_mgv_resolve(pTHX_ modperl_handler_t *handler,
apr_pool_t *p, const char *name)
{
CV *cv;
GV *gv;
HV *stash=Nullhv;
char *handler_name = "handler";
char *tmp;
if (strnEQ(name, "sub ", 4)) {
MP_TRACE_h(MP_FUNC, "handler is anonymous\n");
MpHandlerANON_On(handler);
MpHandlerPARSED_On(handler);
return 1;
}
if ((tmp = strstr((char *)name, "-"))) {
int package_len = strlen(name) - strlen(tmp);
char *pac
cvs commit: modperl-2.0/src/modules/perl modperl_pcw.c modperl_pcw.h
dougm 01/03/09 15:42:28
Added: src/modules/perl modperl_pcw.c modperl_pcw.h
Log:
module for walking the parsed Apache configuration
Revision ChangesPath
1.1 modperl-2.0/src/modules/perl/modperl_pcw.c
Index: modperl_pcw.c
===
#include "mod_perl.h"
/*
* pcw == Parsed Config Walker
* generic functions for walking parsed config using callbacks
*/
void ap_pcw_walk_location_config(apr_pool_t *pconf, server_rec *s,
core_server_config *sconf,
module *modp,
ap_pcw_dir_walker dw, void *data)
{
int i;
ap_conf_vector_t **urls = (ap_conf_vector_t **)sconf-sec_url-elts;
for (i = 0; i sconf-sec_url-nelts; i++) {
core_dir_config *conf =
ap_get_module_config(urls[i], core_module);
void *dir_cfg = ap_get_module_config(urls[i], modp);
if (!dw(pconf, s, dir_cfg, conf-d, data)) {
break;
}
}
}
void ap_pcw_walk_directory_config(apr_pool_t *pconf, server_rec *s,
core_server_config *sconf,
module *modp,
ap_pcw_dir_walker dw, void *data)
{
int i;
ap_conf_vector_t **dirs = (ap_conf_vector_t **)sconf-sec-elts;
for (i = 0; i sconf-sec-nelts; i++) {
core_dir_config *conf =
ap_get_module_config(dirs[i], core_module);
void *dir_cfg = ap_get_module_config(dirs[i], modp);
if (!dw(pconf, s, dir_cfg, conf-d, data)) {
break;
}
}
}
void ap_pcw_walk_files_config(apr_pool_t *pconf, server_rec *s,
core_dir_config *dconf,
module *modp,
ap_pcw_dir_walker dw, void *data)
{
int i;
ap_conf_vector_t **dirs = (ap_conf_vector_t **)dconf-sec-elts;
for (i = 0; i dconf-sec-nelts; i++) {
core_dir_config *conf =
ap_get_module_config(dirs[i], core_module);
void *dir_cfg = ap_get_module_config(dirs[i], modp);
if (!dw(pconf, s, dir_cfg, conf-d, data)) {
break;
}
}
}
void ap_pcw_walk_default_config(apr_pool_t *pconf, server_rec *s,
module *modp,
ap_pcw_dir_walker dw, void *data)
{
core_dir_config *conf =
ap_get_module_config(s-lookup_defaults, core_module);
void *dir_cfg =
ap_get_module_config(s-lookup_defaults, modp);
dw(pconf, s, dir_cfg, conf-d, data);
}
void ap_pcw_walk_server_config(apr_pool_t *pconf, server_rec *s,
module *modp,
ap_pcw_srv_walker sw, void *data)
{
void *cfg = ap_get_module_config(s-module_config, modp);
if (!cfg) {
return;
}
sw(pconf, s, cfg, data);
}
void ap_pcw_walk_config(apr_pool_t *pconf, server_rec *s,
module *modp, void *data,
ap_pcw_dir_walker dw, ap_pcw_srv_walker sw)
{
for (; s; s = s-next) {
core_dir_config *dconf =
ap_get_module_config(s-lookup_defaults,
core_module);
core_server_config *sconf =
ap_get_module_config(s-module_config,
core_module);
if (dw) {
ap_pcw_walk_location_config(pconf, s, sconf, modp, dw, data);
ap_pcw_walk_directory_config(pconf, s, sconf, modp, dw, data);
ap_pcw_walk_files_config(pconf, s, dconf, modp, dw, data);
ap_pcw_walk_default_config(pconf, s, modp, dw, data);
}
if (sw) {
ap_pcw_walk_server_config(pconf, s, modp, sw, data);
}
}
}
1.1 modperl-2.0/src/modules/perl/modperl_pcw.h
Index: modperl_pcw.h
===
#ifndef MODPERL_PCW_H
#define MODPERL_PCW_H
typedef int (*ap_pcw_dir_walker) (apr_pool_t *, server_rec *,
void *, char *, void *);
typedef int (*ap_pcw_srv_walker) (apr_pool_t *, server_rec *,
void *, void *);
void ap_pcw_walk_location_config(apr_pool_t *pconf, server_rec *s,
core_server_config *sconf,
module *modp,
ap_pcw_dir_walker dw, void *data);
void ap_pcw_walk_directory_config(apr_pool_t *pconf, server_rec *s,
core_server_con
cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h modperl_callback.c modperl_callback.h modperl_config.c modperl_config.h modperl_filter.c modperl_interp.c modperl_types.h modperl_util.c modperl_util.h
dougm 01/03/09 15:46:38
Modified:lib/ModPerl Code.pm
src/modules/perl mod_perl.c mod_perl.h modperl_callback.c
modperl_callback.h modperl_config.c
modperl_config.h modperl_filter.c modperl_interp.c
modperl_types.h modperl_util.c modperl_util.h
Log:
remove use of Perl structures in modperl_handler_t,
as they are not usable in a threaded environment.
replace with pre-hashed mgv structures for fast lookup
Revision ChangesPath
1.42 +3 -3 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.41
retrieving revision 1.42
diff -u -r1.41 -r1.42
--- Code.pm 2001/02/22 03:49:22 1.41
+++ Code.pm 2001/03/09 23:46:33 1.42
@@ -87,10 +87,10 @@
#XXX: allow disabling of PerDir hooks on a PerDir basis
my @hook_flags = (map { canon_uc($_) } keys %hooks);
my %flags = (
-Srv = [qw(NONE CLONE PARENT ENABLED), @hook_flags, 'UNSET'],
+Srv = [qw(NONE CLONE PARENT ENABLED AUTOLOAD), @hook_flags, 'UNSET'],
Dir = [qw(NONE SEND_HEADER SETUP_ENV UNSET)],
Interp = [qw(NONE IN_USE PUTBACK CLONED BASE)],
-Handler = [qw(NONE PARSED METHOD OBJECT ANON)],
+Handler = [qw(NONE PARSED METHOD OBJECT ANON AUTOLOAD)],
);
my %flags_lookup = map { $_,1 } qw(Srv Dir);
@@ -453,7 +453,7 @@
);
my @c_src_names = qw(interp tipool log config options callback gtop
- util filter);
+ util filter mgv pcw);
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] }
1.29 +22 -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.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- mod_perl.c2001/02/04 22:19:11 1.28
+++ mod_perl.c2001/03/09 23:46:34 1.29
@@ -115,6 +115,24 @@
}
}
+#ifdef USE_ITHREADS
+static void modperl_init_clones(server_rec *s, apr_pool_t *p)
+{
+for (; s; s=s-next) {
+MP_dSCFG(s);
+if (scfg-mip-tipool-idle) {
+MP_TRACE_i(MP_FUNC, "%s interp already cloned\n",
+ s-server_hostname);
+}
+else {
+MP_TRACE_i(MP_FUNC, "cloning interp for %s\n",
+ s-server_hostname);
+modperl_tipool_init(scfg-mip-tipool);
+}
+}
+}
+#endif
+
void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog,
apr_pool_t *ptemp, server_rec *s)
{
@@ -139,6 +157,10 @@
ap_add_version_component(pconf, MP_VERSION_STRING);
ap_add_version_component(pconf,
Perl_form(aTHX_ "Perl/v%vd", PL_patchlevel));
+modperl_mgv_hash_handlers(pconf, s);
+#ifdef USE_ITHREADS
+modperl_init_clones(s, pconf);
+#endif
}
void modperl_register_hooks(apr_pool_t *p)
1.26 +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.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- mod_perl.h2001/01/21 23:19:03 1.25
+++ mod_perl.h2001/03/09 23:46:34 1.26
@@ -23,6 +23,8 @@
#include "modperl_options.h"
#include "modperl_directives.h"
#include "modperl_filter.h"
+#include "modperl_pcw.h"
+#include "modperl_mgv.h"
void modperl_init(server_rec *s, apr_pool_t *p);
void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog,
1.21 +55 -251 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- modperl_callback.c2001/03/04 18:41:33 1.20
+++ modperl_callback.c2001/03/09 23:46:35 1.21
@@ -1,41 +1,23 @@
#include "mod_perl.h"
-static void require_module(pTHX_ const char *pv)
+modperl_handler_t *modperl_handler_new(apr_pool_t *p, const char *name)
{
-SV* sv;
-dSP;
-PUSHSTACKi(PERLSI_REQUIRE);
-PUTBACK;
-sv = sv_newmortal();
-sv_setpv(sv, "require ");
-sv
cvs commit: modperl-2.0/xs/APR/Pool APR__Pool.h
dougm 01/03/05 21:16:26
Modified:xs modperl_xs_util.h
xs/APR/Pool APR__Pool.h
Log:
shutup fussy compiler
Revision ChangesPath
1.2 +2 -2 modperl-2.0/xs/modperl_xs_util.h
Index: modperl_xs_util.h
===
RCS file: /home/cvs/modperl-2.0/xs/modperl_xs_util.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_xs_util.h 2001/03/05 03:48:15 1.1
+++ modperl_xs_util.h 2001/03/06 05:16:24 1.2
@@ -33,8 +33,8 @@
#define mpxs_sv_is_object(sv) \
(SvROK(sv) (SvTYPE(SvRV(sv)) == SVt_PVMG))
-#define mpxs_sv_object_deref(sv) \
-(mpxs_sv_is_object(sv) ? SvIV((SV*)SvRV(sv)) : NULL)
+#define mpxs_sv_object_deref(sv, type) \
+(mpxs_sv_is_object(sv) ? (type *)SvIVX((SV*)SvRV(sv)) : NULL)
#define mpxs_sv2_obj(obj, sv) \
(obj = mp_xs_sv2_##obj(sv))
1.2 +1 -1 modperl-2.0/xs/APR/Pool/APR__Pool.h
Index: APR__Pool.h
===
RCS file: /home/cvs/modperl-2.0/xs/APR/Pool/APR__Pool.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- APR__Pool.h 2001/03/05 03:53:29 1.1
+++ APR__Pool.h 2001/03/06 05:16:25 1.2
@@ -2,7 +2,7 @@
static MP_INLINE apr_pool_t *mpxs_apr_pool_create(pTHX_ SV *obj)
{
-apr_pool_t *parent = (apr_pool_t *)mpxs_sv_object_deref(obj);
+apr_pool_t *parent = mpxs_sv_object_deref(obj, apr_pool_t);
apr_pool_t *retval = NULL;
(void)apr_pool_create(retval, parent);
return retval;
cvs commit: modperl-2.0/lib/Apache Build.pm ParseSource.pm
dougm 01/03/04 15:22:51
Modified:lib/Apache Build.pm ParseSource.pm
Log:
look in MP_INCLUDE_DIR when scanning source
Apache::Build::AUTOLOAD for accessing MP_* data
Revision ChangesPath
1.35 +15 -4 modperl-2.0/lib/Apache/Build.pm
Index: Build.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/Build.pm,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- Build.pm 2001/03/04 19:41:56 1.34
+++ Build.pm 2001/03/04 23:22:49 1.35
@@ -13,7 +13,20 @@
use constant IS_MOD_PERL_BUILD = grep { -e "$_/lib/mod_perl.pm" } qw(. ..);
our $VERSION = '0.01';
+our $AUTOLOAD;
+sub AUTOLOAD {
+my $self = shift;
+my $name = uc ((split '::', $AUTOLOAD)[-1]);
+unless ($name =~ /^MP_/) {
+die "no such method: $AUTOLOAD";
+}
+unless ($self-{$name}) {
+return wantarray ? () : undef;
+}
+return wantarray ? (split /\s+/, $self-{$name}) : $self-{$name};
+}
+
#--- apxs stuff ---
our $APXS;
@@ -784,6 +797,8 @@
my $os = is_win32 ? 'win32' : 'unix';
my @inc = $self-file_path("src/modules/perl", "xs");
+push @inc, $self-mp_include_dir;
+
my $ainc = $self-apxs('-q' = 'INCLUDEDIR');
if (-d $ainc) {
push @inc, $ainc;
@@ -804,10 +819,6 @@
$ssl_dir = join '/', $self-{MP_SSL_BASE} || '', 'include';
}
push @inc, $ssl_dir if -d $ssl_dir;
-
-if ($self-{MP_INCLUDE_DIR}) {
-push @inc, split /\s+/, $self-{MP_INCLUDE_DIR};
-}
return \@inc;
}
1.11 +19 -13modperl-2.0/lib/Apache/ParseSource.pm
Index: ParseSource.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/ParseSource.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- ParseSource.pm2001/03/03 23:08:58 1.10
+++ ParseSource.pm2001/03/04 23:22:49 1.11
@@ -10,7 +10,7 @@
my $class = shift;
my $self = bless {
-config = Apache::Build-new,
+config = Apache::Build-build_config,
@_,
}, $class;
@@ -65,7 +65,11 @@
bless $c, 'Apache::ParseSource::Scan';
}
-sub include_dir { shift-config-apxs(-q = 'INCLUDEDIR') }
+sub include_dirs {
+my $self = shift;
+($self-config-apxs(-q = 'INCLUDEDIR'),
+ $self-config-mp_include_dir);
+}
sub includes { shift-config-includes }
@@ -76,24 +80,26 @@
require File::Find;
-my $dir = $self-include_dir;
+my(@dirs) = $self-include_dirs;
-unless (-d $dir) {
+unless (-d $dirs[0]) {
die "could not find include directory";
}
my @includes;
my $unwanted = join '|', qw(ap_listen internal);
-File::Find::finddepth({
- wanted = sub {
- return unless /\.h$/;
- return if /($unwanted)/o;
- my $dir = $File::Find::dir;
- push @includes, "$dir/$_";
- },
- follow = 1,
- }, $dir);
+for my $dir (@dirs) {
+File::Find::finddepth({
+ wanted = sub {
+ return unless /\.h$/;
+ return if /($unwanted)/o;
+ my $dir = $File::Find::dir;
+ push @includes, "$dir/$_";
+ },
+ follow = 1,
+ }, $dir);
+}
#include apr_*.h before the others
my @wanted = grep { /apr_\w+\.h$/ } @includes;
cvs commit: modperl-2.0/lib/ModPerl ParseSource.pm
dougm 01/03/04 15:26:53
Added: lib/ModPerl ParseSource.pm
Log:
subclass of Apache::ParseSource for building ModPerl::FunctionTable
Revision ChangesPath
1.1 modperl-2.0/lib/ModPerl/ParseSource.pm
Index: ParseSource.pm
===
package ModPerl::ParseSource;
use strict;
use Config ();
use Apache::ParseSource ();
our @ISA = qw(Apache::ParseSource);
our $VERSION = '0.01';
sub includes {
my $self = shift;
my $dirs = $self-SUPER::includes;
return [
'.', qw(xs src/modules/perl),
@$dirs,
"$Config::Config{archlibexp}/CORE",
];
}
sub include_dirs { '.' }
sub find_includes {
my $self = shift;
my $includes = $self-SUPER::find_includes;
#filter/sort
my @wanted = grep { /mod_perl\.h/ } @$includes;
push @wanted, grep { m:xs/modperl_xs_: } @$includes;
push @wanted, grep { m:xs/A: } @$includes;
\@wanted;
}
my $prefixes = join '|', qw(modperl_|mpxs_|mp_xs);
my $prefix_re = qr{^($prefixes)};
sub wanted_functions { $prefix_re }
sub write_functions_pm {
my $self = shift;
my $file = shift || 'FunctionTable.pm';
my $name = shift || 'ModPerl::FunctionTable';
$self-SUPER::write_functions_pm($file, $name);
}
for my $method (qw(get_constants get_structs write_structs_pm get_structs)) {
no strict 'refs';
*$method = sub { die __PACKAGE__ . "-$method not implemented" };
}
1;
__END__
cvs commit: modperl-2.0/lib/Apache ParseSource.pm
dougm 01/03/04 16:04:55
Modified:lib/Apache ParseSource.pm
Log:
skip version.h (e.g. automake generated and not public)
Revision ChangesPath
1.12 +2 -2 modperl-2.0/lib/Apache/ParseSource.pm
Index: ParseSource.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/ParseSource.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- ParseSource.pm2001/03/04 23:22:49 1.11
+++ ParseSource.pm2001/03/05 00:04:55 1.12
@@ -87,13 +87,13 @@
}
my @includes;
-my $unwanted = join '|', qw(ap_listen internal);
+my $unwanted = join '|', qw(ap_listen internal version);
for my $dir (@dirs) {
File::Find::finddepth({
wanted = sub {
return unless /\.h$/;
- return if /($unwanted)/o;
+ return if /^($unwanted)/o;
my $dir = $File::Find::dir;
push @includes, "$dir/$_";
},
cvs commit: modperl-2.0/xs/APR/Lock - New directory
dougm 01/03/04 19:43:15 modperl-2.0/xs/APR/Lock - New directory
cvs commit: modperl-2.0/xs/APR/APR - New directory
dougm 01/03/04 19:43:12 modperl-2.0/xs/APR/APR - New directory
cvs commit: modperl-2.0/lib/ModPerl FunctionMap.pm
dougm 01/03/04 19:44:58
Added: lib/ModPerl FunctionMap.pm
Log:
module for mapping functions
Revision ChangesPath
1.1 modperl-2.0/lib/ModPerl/FunctionMap.pm
Index: FunctionMap.pm
===
package ModPerl::FunctionMap;
use strict;
use warnings FATAL = 'all';
use ModPerl::MapUtil qw();
use ModPerl::ParseSource ();
use Apache::FunctionTable ();
use ModPerl::FunctionTable ();
our @ISA = qw(ModPerl::MapBase);
sub new {
my $class = shift;
bless {}, $class;
}
#for adding to function.map
sub generate {
my $self = shift;
my $missing = $self-check;
return unless $missing;
print " $_\n" for @$missing;
}
sub disabled { shift-{disabled} }
#look for functions that do not exist in *.map
sub check {
my $self = shift;
my $map = $self-get;
my @missing;
my $mp_func = ModPerl::ParseSource-wanted_functions;
for my $name (map $_-{name}, @{ $self-function_table() }) {
next if exists $map-{$name};
push @missing, $name unless $name =~ /^($mp_func)/o;
}
return @missing ? \@missing : undef;
}
#look for functions in *.map that do not exist
my $special_name = qr{(^DEFINE_|DESTROY$)};
sub check_exists {
my $self = shift;
my %functions = map { $_-{name}, 1 } @{ $self-function_table() };
my @missing = ();
for my $name (keys %{ $self-{map} }) {
next if $functions{$name};
push @missing, $name unless $name =~ $special_name;
}
return @missing ? \@missing : undef;
}
my $keywords = join '|', qw(MODULE PACKAGE PREFIX);
sub guess_prefix {
my $entry = shift;
my($name, $class) = ($entry-{name}, $entry-{class});
my $prefix = "";
$name =~ s/^DEFINE_//;
(my $guess = lc($entry-{class} || $entry-{module}) . '_') =~ s/::/_/g;
$guess =~ s/apache_/ap_/;
if ($name =~ /^$guess/) {
$prefix = $guess;
}
else {
if ($name =~ /^(apr?_)/) {
$prefix = $1;
}
}
#print "GUESS prefix=$guess, name=$entry-{name} - $prefix\n";
return $prefix;
}
sub parse {
my($self, $fh, $map) = @_;
my %cur;
my $disabled = 0;
while ($fh-readline) {
if (/($keywords)=/o) {
$disabled = s/^\W//; #module is disabled
my %words = $self-parse_keywords($_);
if ($words{MODULE}) {
%cur = ();
}
for (keys %words) {
$cur{$_} = $words{$_};
}
next;
}
my($name, $dispatch, $argspec, $alias) = split /\s*\|\s*/;
my $return_type;
if ($name =~ s/^([^:]+)://) {
$return_type = $1;
}
if ($name =~ s/^(\W)// or not $cur{MODULE} or $disabled) {
#notimplemented or cooked by hand
$map-{$name} = undef;
push @{ $self-{disabled}-{ $1 || '!' } }, $name;
next;
}
my $entry = $map-{$name} = {
name= $alias || $name,
dispatch= $dispatch,
argspec = $argspec ? [split /\s*,\s*/, $argspec] : "",
return_type = $return_type,
alias = $alias,
};
if (my $package = $cur{PACKAGE}) {
unless ($package eq 'guess') {
$cur{CLASS} = $package;
}
}
else {
$cur{CLASS} = $cur{MODULE};
}
for (keys %cur) {
$entry-{lc $_} = $cur{$_};
}
$entry-{prefix} ||= guess_prefix($entry);
#avoid 'use of uninitialized value' warnings
$entry-{$_} ||= "" for keys %{ $entry };
if ($entry-{dispatch} =~ /_$/) {
$entry-{dispatch} .= $name;
}
}
}
sub get {
my $self = shift;
$self-{map} ||= $self-parse_map_files;
}
sub prefixes {
my $self = shift;
$self = ModPerl::FunctionMap-new unless ref $self;
my $map = $self-get;
my %prefix;
while (my($name, $ent) = each %$map) {
next unless $ent-{prefix};
$prefix{ $ent-{prefix} }++;
}
[keys %prefix]
}
1;
__END__
cvs commit: modperl-2.0/lib/ModPerl TypeMap.pm
dougm 01/03/04 19:45:23
Added: lib/ModPerl TypeMap.pm
Log:
module for mapping types and data structures
Revision ChangesPath
1.1 modperl-2.0/lib/ModPerl/TypeMap.pm
Index: TypeMap.pm
===
package ModPerl::TypeMap;
use strict;
use warnings FATAL = 'all';
use Apache::StructureTable ();
use Apache::FunctionTable ();
use ModPerl::FunctionMap ();
use ModPerl::StructureMap ();
use ModPerl::MapUtil qw(list_first);
our @ISA = qw(ModPerl::MapBase);
sub new {
my $class = shift;
my $self = bless { INCLUDE = [] }, $class;
$self-{function_map} = ModPerl::FunctionMap-new,
$self-{structure_map} = ModPerl::StructureMap-new,
$self-get;
$self;
}
my %special = map { $_, 1 } qw(UNDEFINED NOTIMPL CALLBACK);
sub special {
my($self, $class) = @_;
return $special{$class};
}
sub function_map { shift-{function_map}-get }
sub structure_map { shift-{structure_map}-get }
sub parse {
my($self, $fh, $map) = @_;
while ($fh-readline) {
if (/E=/) {
my %args = $self-parse_keywords($_);
while (my($key,$val) = each %args) {
push @{ $self-{$key} }, $val;
}
next;
}
my @aliases;
my($type, $class) = (split /\s*\|\s*/, $_)[0,1];
$class ||= 'UNDEFINED';
if ($type =~ s/^struct\s+(.*)/$1/) {
push @aliases,
$type, "$type *", "const $type *",
"struct $type *", "const struct $type *",
"$type **";
my $cname = $class;
if ($cname =~ s/::/__/) {
push @{ $self-{typedefs} }, [$type, $cname];
}
}
elsif ($type =~ /_t$/) {
push @aliases, $type, "$type *", "const $type *";
}
else {
push @aliases, $type;
}
for (@aliases) {
$map-{$_} = $class;
}
}
}
sub get {
my $self = shift;
$self-{map} ||= $self-parse_map_files;
}
my $ignore = join '|', qw{
ap_LINK ap_HOOK _ UINT union._
union.block_hdr cleanup process_chain
iovec struct.rlimit Sigfunc in_addr_t
};
sub should_ignore {
my($self, $type) = @_;
return 1 if $type =~ /^($ignore)/o;
}
sub is_callback {
my($self, $type) = @_;
return 1 if $type =~ /\(/ and $type =~ /\)/; #XXX: callback
}
sub exists {
my($self, $type) = @_;
return 1 if $self-is_callback($type) || $self-should_ignore($type);
$type =~ s/\[\d+\]$//; #char foo[64]
return exists $self-get-{$type};
}
sub map_type {
my($self, $type) = @_;
my $class = $self-get-{$type};
return unless $class and ! $self-special($class);
#return if $type =~ /\*\*$/; #XXX
if ($class =~ /::/) {
return $class;
}
else {
return $type;
}
}
sub null_type {
my($self, $type) = @_;
my $class = $self-get-{$type};
if ($class =~ /^[INU]V/) {
return '0';
}
else {
return 'NULL';
}
}
sub can_map {
my $self = shift;
my $map = shift;
return 1 if $map-{argspec};
for (@_) {
return unless $self-map_type($_);
}
return 1;
}
sub map_arg {
my($self, $arg) = @_;
return {
name= $arg-{name},
default = $arg-{default},
type= $self-map_type($arg-{type}),
rtype = $arg-{type},
}
}
sub map_args {
my($self, $func) = @_;
my $entry = $self-function_map-{ $func-{name} };
my $argspec = $entry-{argspec};
my $args = [];
if ($argspec) {
$entry-{orig_args} = [ map $_-{name}, @{ $func-{args} } ];
for my $arg (@$argspec) {
my $default;
($arg, $default) = split /=/, $arg, 2;
my($type, $name) = split ':', $arg, 2;
if ($type and $name) {
push @$args, {
name = $name,
type = $type,
default = $default,
};
}
else {
my $e = list_first { $_-{name} eq $arg } @{ $func-{args} };
if ($e) {
push @$args, { %$e, default = $default };
}
elsif ($arg eq '...') {
push @$args, { name = '...', type = 'SV *' };
}
else {
warn "bad argspec: $func-{name} ($arg)\n";
}
}
}
}
else {
cvs commit: modperl-2.0/lib/ModPerl StructureMap.pm
dougm 01/03/04 19:45:47
Added: lib/ModPerl StructureMap.pm
Log:
module for mapping data structures
Revision ChangesPath
1.1 modperl-2.0/lib/ModPerl/StructureMap.pm
Index: StructureMap.pm
===
package ModPerl::StructureMap;
use strict;
use warnings FATAL = 'all';
use Apache::StructureTable ();
use ModPerl::MapUtil ();
our @ISA = qw(ModPerl::MapBase);
sub new {
my $class = shift;
bless {}, $class;
}
sub generate {
my $self = shift;
my $map = $self-get;
for my $entry (@$Apache::StructureTable) {
my $type = $entry-{type};
my $elts = $entry-{elts};
next unless @$elts;
next if $type =~ $self-{IGNORE_RE};
next unless grep {
not exists $map-{$type}-{ $_-{name} }
} @$elts;
print "$type\n";
for my $e (@$elts) {
print " $e-{name}\n";
}
print "/$type\n\n";
}
}
sub disabled { shift-{disabled} }
sub check {
my $self = shift;
my $map = $self-get;
my @missing;
for my $entry (@$Apache::StructureTable) {
my $type = $entry-{type};
for my $name (map $_-{name}, @{ $entry-{elts} }) {
next if exists $map-{$type}-{$name};
next if $type =~ $self-{IGNORE_RE};
push @missing, "$type.$name";
}
}
return @missing ? \@missing : undef;
}
sub check_exists {
my $self = shift;
my %structures;
for my $entry (@$Apache::StructureTable) {
$structures{ $entry-{type} } = { map {
$_-{name}, 1
} @{ $entry-{elts} } };
}
my @missing;
while (my($type, $elts) = each %{ $self-{map} }) {
for my $name (keys %$elts) {
next if exists $structures{$type}-{$name};
push @missing, "$type.$name";
}
}
return @missing ? \@missing : undef;
}
sub parse {
my($self, $fh, $map) = @_;
my($disabled, $class);
my %cur;
while ($fh-readline) {
if (m:^(\W?)/?([^]+):) {
$disabled = $1;
my $args = $2;
%cur = ();
if ($args =~ /E=/) {
%cur = $self-parse_keywords($args);
}
$class = $cur{STRUCT} || $args;
$self-{MODULES}-{$class} = $cur{MODULE} if $cur{MODULE};
next;
}
elsif (s/^(\w+):\s*//) {
push @{ $self-{$1} }, split /\s+/;
next;
}
if (s/^(\W)\s*// or $disabled) {
$map-{$class}-{$_} = undef;
push @{ $self-{disabled}-{ $1 || '!' } }, "$class.$_";
}
else {
$map-{$class}-{$_} = 1;
}
}
if (my $ignore = $self-{IGNORE}) {
$ignore = join '|', @$ignore;
$self-{IGNORE_RE} = qr{^($ignore)};
}
else {
$self-{IGNORE_RE} = qr{^$};
}
}
sub get {
my $self = shift;
$self-{map} ||= $self-parse_map_files;
}
1;
__END__
cvs commit: modperl-2.0/lib/ModPerl WrapXS.pm
dougm 01/03/04 19:47:33
Added: lib/ModPerl WrapXS.pm
Log:
module to generating the Makefile.PL, .pm and .xs for a module
Revision ChangesPath
1.1 modperl-2.0/lib/ModPerl/WrapXS.pm
Index: WrapXS.pm
===
package ModPerl::WrapXS;
use strict;
use warnings FATAL = 'all';
use Apache::Build ();
use ModPerl::Code ();
use ModPerl::TypeMap ();
use ModPerl::MapUtil qw(function_table xs_glue_dirs);
use File::Path qw(rmtree mkpath);
use Cwd qw(fastcwd);
use Data::Dumper;
our $VERSION = '0.01';
my(@xs_includes) = ('mod_perl.h',
map "modperl_xs_$_.h", qw(util typedefs sv_convert));
sub new {
my $class = shift;
my $self = bless {
typemap = ModPerl::TypeMap-new,
includes = \@xs_includes,
glue_dirs = [xs_glue_dirs()],
}, $class;
for (qw(c hash)) {
my $w = "noedit_warning_$_";
my $method = "ModPerl::Code::$w";
$self-{$w} = $self-$method();
}
$self-typemap-get;
$self;
}
sub typemap { shift-{typemap} }
sub includes { shift-{includes} }
sub function_list {
my $self = shift;
my(@list) = @{ function_table() };
while (my($name, $val) = each %{ $self-typemap-function_map }) {
#entries that do not exist in C::Scan generated tables
next unless $name =~ /^DEFINE_/;
push @list, $val;
}
return \@list;
}
sub get_functions {
my $self = shift;
my $typemap = $self-typemap;
for my $entry (@{ $self-function_list() }) {
my $func;
next unless $func = $typemap-map_function($entry);
my($name, $module, $class, $args) =
@{ $func } { qw(perl_name module class args) };
#eg ap_fputs()
if ($name =~ s/^DEFINE_//) {
$func-{name} =~ s/^DEFINE_//;
if (needs_prefix($func-{name})) {
#e.g. DEFINE_add_output_filter
$func-{name} = make_prefix($func-{name}, $class);
}
}
my $xs_parms = join ', ',
map { defined $_-{default} ?
"$_-{name}=$_-{default}" : $_-{name} } @$args;
(my $parms = $xs_parms) =~ s/=[^,]+//g; #strip defaults
my $proto = join "\n",
(map "$_-{type} $_-{name}", @$args), "";
my($dispatch, $orig_args) =
@{ $func } {qw(dispatch orig_args)};
if ($dispatch =~ /^MPXS_/) {
$name =~ s/^$func-{prefix}//;
push @{ $self-{newXS}-{ $module } },
["$class\::$name", $dispatch];
next;
}
my $passthru = @$args $args-[0]-{name} eq '...';
if ($passthru) {
$parms = '...';
$proto = '';
}
my $return_type =
$name =~ /^DESTROY$/ ? 'void' : $func-{return_type};
my $code = EOF;
$return_type
$name($xs_parms)
$proto
EOF
if ($dispatch || $orig_args) {
my $thx = "";
if ($dispatch) {
$thx = 'aTHX_ ' if $dispatch =~ /^mpxs_/i;
}
else {
if ($orig_args and @$orig_args == @$args) {
#args were reordered
$parms = join ', ', @$orig_args;
}
$dispatch = $func-{name};
}
if ($passthru) {
$parms = 'items, MARK+1, SP';
}
my $retval = $return_type eq 'void' ?
["", ""] : ["RETVAL = ", "OUTPUT:\nRETVAL\n"];
$code .= EOF;
CODE:
$retval-[0]$dispatch($thx$parms);
$retval-[1]
EOF
}
$func-{code} = $code;
push @{ $self-{XS}-{ $module } }, $func;
}
}
sub get_value {
my $e = shift;
my $val = 'val';
if ($e-{class} eq 'PV') {
if (my $pool = $e-{pool}) {
$pool =~ s/^\./obj-/;
$val = "((ST(1) == PL_sv_undef) ? NULL :
(SvPOK(ST(1)) ?
apr_pstrndup($pool, SvPVX(ST(1)), SvCUR(ST(1))) :
apr_pstrdup($pool, val)))";
}
}
return $val;
}
sub get_structures {
my $self = shift;
my $typemap = $self-typemap;
for my $entry (@$Apache::StructureTable) {
my $struct = $typemap-map_structure($entry);
next unless $struct;
my $class = $struct-{class};
for my $e (@{ $struct-{elts} }) {
my($name, $default, $type) =
@{$e}{qw
cvs commit: modperl-2.0/xs modperl_xs_util.h
dougm 01/03/04 19:48:15
Added: xs modperl_xs_util.h
Log:
utilties for extensions
Revision ChangesPath
1.1 modperl-2.0/xs/modperl_xs_util.h
Index: modperl_xs_util.h
===
#ifndef MODPERL_XS_H
#define MODPERL_XS_H
#ifndef dAX
#define dAXI32 ax = mark - PL_stack_base + 1
#endif
#ifndef dITEMS
#define dITEMS I32 items = SP - MARK
#endif
#define mpxs_sv_grow(sv, len) \
(void)SvUPGRADE(sv, SVt_PV); \
SvGROW(sv, len+1)
#define mpxs_sv_cur_set(sv, len) \
SvCUR_set(sv, len); \
*SvEND(sv) = '\0'; \
SvPOK_only(sv)
#define mpxs_set_targ(func, arg) \
STMT_START { \
dXSTARG; \
XSprePUSH; \
func(aTHX_ TARG, arg); \
PUSHTARG; \
XSRETURN(1); \
} STMT_END
#define mpxs_cv_name() \
HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv))
#define mpxs_sv_is_object(sv) \
(SvROK(sv) (SvTYPE(SvRV(sv)) == SVt_PVMG))
#define mpxs_sv_object_deref(sv) \
(mpxs_sv_is_object(sv) ? SvIV((SV*)SvRV(sv)) : NULL)
#define mpxs_sv2_obj(obj, sv) \
(obj = mp_xs_sv2_##obj(sv))
#define mpxs_usage_items_1(arg) \
if (items != 1) { \
Perl_croak(aTHX_ "usage: %s::%s(%s)", \
mpxs_cv_name(), arg); \
}
#define mpxs_usage_va(i, obj, msg) \
if ((items i) || !(mpxs_sv2_obj(obj, *MARK))) \
croak("usage: %s", msg); \
MARK++
#define mpxs_usage_va_1(obj, msg) mpxs_usage_va(1, obj, msg)
#define mpxs_usage_va_2(obj, arg, msg) \
mpxs_usage_va(2, obj, msg); \
arg = *MARK++
#endif /* MODPERL_XS_H */
cvs commit: modperl-2.0/xs/maps apache_functions.map apache_structures.map apache_types.map
dougm 01/03/04 19:49:12
Added: xs/maps apache_functions.map apache_structures.map
apache_types.map
Log:
the function/structure/type maps for apache
Revision ChangesPath
1.1 modperl-2.0/xs/maps/apache_functions.map
Index: apache_functions.map
===
## Apache functions ##
#keywords:
# MODULE = the module name
# e.g. Apache::Connection - Apache/Connection.{pm,xs}
#
# PACKAGE = the package name functions belong to, defaults to MODULE
# value of 'guess' indicates that package name should be
# guessed based on first argument found that maps to a Perl class
# fallsback on the prefix (ap_ - Apache, apr_ - APR)
#
# PREFIX = prefix to be stripped
# defaults to PACKAGE, converted to C name convention, e.g.
# APR::Base64 - apr_base64_
# if the converted prefix does not match, defaults to ap_ or apr_
#format of entries:
# C function name | dispatch function name | argspec | Perl alias
# dispatch function name defaults to C function name
# if the dispatch name is just a prefix (mpxs_, MPXS_)
# the C function name is appended to it
# the return type can be specified before the C function name,
# defaults to return_type in {Apache,ModPerl}::FunctionTable
# the argspec defaults to arguments in {Apache,ModPerl}::FunctionTable
# argument types can be specified to override those in the FunctionTable
# default values can be specified, e.g. arg=default_value
# argspec of '...' indicates passthru, calling the function with
# (aTHX_ I32 items, SP **sp, SV **MARK)
# the alias will be created in the current PACKAGE
# function names that do not begin with /^\w/ are skipped
# for details see: %ModPerl::MapUtil::disabled_map
MODULE=Apache::RequestUtil PACKAGE=guess
ap_finalize_request_protocol
ap_default_port_for_request
ap_default_port_for_scheme
ap_default_type
ap_get_server_name
ap_get_server_port
!ap_content_type_tolower
ap_get_status_line
ap_is_initial_req
#MODULE=Apache::RequestConfig
ap_document_root
ap_get_limit_req_body
ap_get_limit_xml_body
ap_core_translate
MODULE=Apache::SubRequest PACKAGE=guess
ap_sub_req_lookup_file
ap_sub_req_lookup_uri
ap_sub_req_method_uri
ap_sub_req_output_filter
ap_set_sub_req_protocol
-ap_finalize_sub_req_protocol
ap_internal_redirect
ap_internal_redirect_handler
MODULE=Apache::SubRequestPACKAGE=Apache::SubRequest
ap_destroy_sub_req
ap_run_sub_req
MODULE=Apache::RequestIO PACKAGE=Apache::RequestRec
ap_discard_request_body
!ap_getline
ap_get_client_block | mpxs_ | r, SV *:buffer, bufsiz
ap_setup_client_block | | r, read_policy=REQUEST_CHUNKED_ERROR
ap_should_client_block
ap_rflush
PREFIX=ap_r
ap_rwrite | | r, buf, nbyte
~ap_rprintf
!ap_rputc
~ap_rputs
ap_rvputs | mpxs_ | ... | puts
-ap_vrprintf
mpxs_Apache__RequestRec_TIEHANDLE
MODULE=Apache::Response PACKAGE=guess
ap_make_etag
ap_set_content_length
ap_set_etag
ap_meets_conditions
ap_rationalize_mtime
ap_update_mtime
ap_send_error_response
ap_send_fd
ap_send_mmap
ap_send_size
ap_set_keepalive
ap_set_last_modified
ap_custom_response
MODULE=Apache::Access PACKAGE=guess
ap_allow_methods
ap_allow_options
ap_allow_overrides
ap_get_remote_logname
!ap_requires
ap_satisfies
#MODULE=Apache::Auth
ap_auth_name
ap_auth_type
ap_get_basic_auth_pw
ap_note_auth_failure
ap_note_basic_auth_failure
ap_note_digest_auth_failure
ap_some_auth_required
!MODULE=Apache::ScriptUtil PACKAGE=guess
ap_add_cgi_vars
ap_add_common_vars
ap_create_environment
ap_find_path_info
-ap_scan_script_header_err
-ap_scan_script_header_err_core
-ap_scan_script_header_err_strs
MODULE=Apache::ServerUtil PACKAGE=guess
ap_add_version_component
ap_construct_server
ap_construct_url | | r,uri,p
ap_error_log2stderr
#MODULE=Apache::ServerConfig
ap_exists_config_define
ap_get_local_host
ap_get_server_built
ap_get_server_version
ap_psignature | | r,prefix
ap_server_root_relative
MODULE=Apache::Connection PACKAGE=guess
ap_get_remote_host
ap_read_request
ap_update_vhost_given_ip
ap_new_connection
!MODULE=Apache::Log PACKAGE=guess
ap_log_assert
ap_log_error
ap_log_perror
ap_log_pid
ap_log_rerror
ap_open_stderr_log
ap_open_logs
!MODULE=Apache::Module
-ap_add_loaded_module
-ap_add_module
-ap_add_named_module
ap_find_linked_module
ap_find_module_name
ap_remove_loaded_module
ap_remove_module
ap_single_module_configure
ap_setup_prelinked_modules
ap_show_directives
ap_show_modules
ap_register_hooks
!MODULE=Apache::Directive
cvs commit: modperl-2.0/xs/maps apr_functions.map apr_structures.map apr_types.map
dougm 01/03/04 19:49:21 Added: xs/maps apr_functions.map apr_structures.map apr_types.map Log: the function/structure/type maps for apr Revision ChangesPath 1.1 modperl-2.0/xs/maps/apr_functions.map Index: apr_functions.map === ## APR Functions ## !MODULE=APR::Poll apr_poll_socket_add apr_poll_socket_clear apr_poll_data_get apr_poll_revents_get apr_poll_socket_mask apr_poll apr_poll_socket_remove apr_poll_data_set apr_poll_setup !MODULE=APR::Time apr_ansi_time_to_apr_time -apr_ctime apr_implode_time -apr_time_now -apr_sleep apr_rfc822_date apr_strftime apr_explode_gmt apr_explode_localtime !MODULE=APR::Array apr_array_append apr_array_cat apr_array_pstrcat apr_array_copy apr_array_copy_hdr apr_array_make apr_array_push MODULE=APR::Socket apr_bind !apr_accept apr_listen apr_connect apr_recv apr_send apr_shutdown MODULE=APR::Socket apr_socket_close !apr_socket_create apr_socket_addr_get apr_socket_data_get apr_socket_data_set apr_getsocketopt apr_setsocketopt -apr_sendfile -apr_sendv apr_socket_from_file !MODULE=APR::SocketAddr apr_sockaddr_info_get apr_sockaddr_ip_get apr_sockaddr_ip_set apr_sockaddr_port_set apr_sockaddr_port_get MODULE=APR::Brigade apr_brigade_create | mpxs_ | SV *:CLASS, p | new apr_brigade_destroy apr_brigade_partition apr_brigade_printf apr_brigade_putstrs apr_brigade_split -apr_brigade_to_iovec -apr_brigade_vprintf -apr_brigade_vputstrs apr_brigade_length apr_brigade_write apr_brigade_puts apr_brigade_putc !MODULE=APR::Bucket apr_bucket_copy_notimpl apr_bucket_shared_copy apr_bucket_eos_create apr_bucket_file_create apr_bucket_flush_create apr_bucket_heap_create apr_bucket_immortal_create apr_bucket_mmap_create apr_bucket_pipe_create apr_bucket_pool_create apr_bucket_socket_create apr_bucket_transient_create apr_bucket_destroy_notimpl apr_bucket_shared_destroy apr_bucket_eos_make apr_bucket_file_make apr_bucket_flush_make apr_bucket_heap_make apr_bucket_immortal_make apr_bucket_mmap_make apr_bucket_pipe_make apr_bucket_pool_make apr_bucket_shared_make apr_bucket_socket_make apr_bucket_transient_make apr_bucket_setaside_notimpl apr_bucket_split_notimpl apr_bucket_shared_split apr_bucket_simple_split apr_bucket_simple_copy MODULE=APR::Pool apr_pool_free_blocks_num_bytes apr_pool_num_bytes apr_pool_cleanup_for_exec apr_pool_clear apr_pool_destroy apr_pool_t *:apr_pool_create | mpxs_ | SV *:obj | new apr_pool_userdata_get apr_pool_userdata_set apr_pool_alloc_init apr_pool_alloc_term apr_pool_cleanup_kill apr_pool_cleanup_run -apr_pool_cleanup_null apr_pool_cleanup_register apr_pool_sub_make apr_pool_note_subprocess -apr_palloc -apr_pcalloc -apr_pmemdup MODULE=APR::Lock !apr_lock_child_init apr_lock_t *:apr_lock_create | mpxs_ | \ SV *:CLASS, cont, type=0, scope=1, fname="lock.file" | new -apr_lock_destroy apr_lock_DESTROY | | lock apr_lock_data_get apr_lock_data_set apr_lock_acquire apr_lock_release MODULE=APR::Table apr_table_clear apr_table_copy| | t, p apr_table_make apr_table_overlap apr_table_overlay | | base, overlay, p apr_table_add -apr_table_addn apr_table_do apr_table_get apr_table_merge -apr_table_mergen apr_table_set -apr_table_setn apr_table_unset -apr_table_vdo !MODULE=APR::File -apr_file_open -apr_file_close -apr_file_namedpipe_create apr_file_pipe_create -apr_file_dup -apr_file_flush -apr_file_eof -apr_file_error -apr_file_gets -apr_file_printf -apr_file_write_full -apr_file_read_full -apr_file_getc -apr_file_ungetc -apr_file_putc -apr_file_puts -apr_file_read -apr_file_write -apr_file_writev -apr_file_seek apr_file_data_get apr_file_info_get apr_file_name_get apr_file_pool_get apr_file_pipe_timeout_get apr_file_pipe_timeout_set apr_file_lock apr_file_unlock apr_file_open_stderr apr_file_open_stdout -apr_file_remove -apr_file_rename apr_file_data_set apr_file_perms_set -MODULE=APR::Finfo apr_lstat apr_stat !MODULE=APR::Strings apr_collapse_spaces -apr_cpystrn apr_fnmatch apr_is_fnmatch -apr_psprintf -apr_pstrcat -apr_pstrdup -apr_pstrndup -apr_pvsprintf apr_strnatcasecmp apr_strnatcmp -apr_tokenize_to_argv !MODULE=APR::ProcAttr apr_procattr_create apr_procattr_child_err_set apr_procattr_child_in_set apr_procattr_child_out_set apr_procattr_cmdtype_set apr_procattr_detach_set apr_procattr_dir_set apr_proca
cvs commit: modperl-2.0/xs/APR/UUID APR__UUID.h
dougm 01/03/04 19:53:29
Added: xs/APR/Base64 APR__Base64.h
xs/APR/Brigade APR__Brigade.h
xs/APR/Lib APR__Lib.h
xs/APR/Lock APR__Lock.h
xs/APR/Pool APR__Pool.h
xs/APR/UUID APR__UUID.h
Log:
start of the wrapper functions for APR
Revision ChangesPath
1.1 modperl-2.0/xs/APR/Base64/APR__Base64.h
Index: APR__Base64.h
===
static MP_INLINE void mpxs_apr_base64_encode(pTHX_ SV *sv, SV *arg)
{
STRLEN len;
int encoded_len;
char *data = SvPV(arg, len);
mpxs_sv_grow(sv, apr_base64_encode_len(len));
encoded_len = apr_base64_encode_binary(SvPVX(sv), data, len);
mpxs_sv_cur_set(sv, encoded_len);
}
static MP_INLINE void mpxs_apr_base64_decode(pTHX_ SV *sv, SV *arg)
{
STRLEN len;
int decoded_len;
char *data = SvPV(arg, len);
mpxs_sv_grow(sv, apr_base64_decode_len(data));
decoded_len = apr_base64_decode_binary(SvPVX(sv), data);
mpxs_sv_cur_set(sv, decoded_len);
}
static XS(MPXS_apr_base64_encode)
{
dXSARGS;
mpxs_usage_items_1("data");
mpxs_set_targ(mpxs_apr_base64_encode, ST(0));
}
static XS(MPXS_apr_base64_decode)
{
dXSARGS;
mpxs_usage_items_1("data");
mpxs_set_targ(mpxs_apr_base64_decode, ST(0));
}
1.1 modperl-2.0/xs/APR/Brigade/APR__Brigade.h
Index: APR__Brigade.h
===
static MP_INLINE apr_bucket_brigade *mpxs_apr_brigade_create(pTHX_ SV *CLASS,
apr_pool_t *p)
{
return apr_brigade_create(p);
}
1.1 modperl-2.0/xs/APR/Lib/APR__Lib.h
Index: APR__Lib.h
===
static MP_INLINE void mpxs_apr_strerror(pTHX_ SV *sv, SV *arg)
{
apr_status_t statcode = mp_xs_sv2_status(arg);
char *ptr;
mpxs_sv_grow(sv, 128-1);
ptr = apr_strerror(statcode, SvPVX(sv), SvLEN(sv));
mpxs_sv_cur_set(sv, strlen(ptr)); /*XXX*/
}
static MP_INLINE void mpxs_apr_generate_random_bytes(pTHX_ SV *sv, SV *arg)
{
int len = (int)SvIV(arg);
mpxs_sv_grow(sv, len);
(void)apr_generate_random_bytes(SvPVX(sv), len);
mpxs_sv_cur_set(sv, len);
}
static XS(MPXS_apr_strerror)
{
dXSARGS;
mpxs_usage_items_1("status_code");
mpxs_set_targ(mpxs_apr_strerror, ST(0));
}
static XS(MPXS_apr_generate_random_bytes)
{
dXSARGS;
mpxs_usage_items_1("length");
mpxs_set_targ(mpxs_apr_generate_random_bytes, ST(0));
}
1.1 modperl-2.0/xs/APR/Lock/APR__Lock.h
Index: APR__Lock.h
===
#define apr_lock_DESTROY(lock) (void)apr_lock_destroy(lock)
static MP_INLINE apr_lock_t *mpxs_apr_lock_create(pTHX_ SV *CLASS,
apr_pool_t *p,
apr_locktype_e type,
apr_lockscope_e scope,
const char *fname)
{
apr_lock_t *retval=NULL;
(void)apr_lock_create(retval, type, scope, fname, p);
return retval;
}
1.1 modperl-2.0/xs/APR/Pool/APR__Pool.h
Index: APR__Pool.h
===
#define apr_pool_DESTROY(p) apr_pool_destroy(p)
static MP_INLINE apr_pool_t *mpxs_apr_pool_create(pTHX_ SV *obj)
{
apr_pool_t *parent = (apr_pool_t *)mpxs_sv_object_deref(obj);
apr_pool_t *retval = NULL;
(void)apr_pool_create(retval, parent);
return retval;
}
1.1 modperl-2.0/xs/APR/UUID/APR__UUID.h
Index: APR__UUID.h
===
#define mpxs_apr_uuid_alloc() \
(apr_uuid_t *)safemalloc(sizeof(apr_uuid_t))
static MP_INLINE apr_uuid_t *mpxs_apr_uuid_get(pTHX_ SV *CLASS)
{
apr_uuid_t *uuid = mpxs_apr_uuid_alloc();
apr_uuid_get(uuid);
return uuid;
}
static MP_INLINE void mp_apr_uuid_format(pTHX_ SV *sv, SV *obj)
{
apr_uuid_t *uuid = mp_xs_sv2_uuid(obj);
mpxs_sv_grow(sv, APR_UUID_FORMATTED_LENGTH);
apr_uuid_format(SvPVX(sv), uuid);
mpxs_sv_cur_set(sv, APR_UUID_FORMATTED_LENGTH);
}
static MP_INLINE apr_uuid_t *mpxs_apr_uuid_parse(pTHX_ SV *CLASS, char *buf)
{
apr_uuid_t *uuid = mpxs_apr_uuid_alloc();
apr_uuid_parse(uuid, buf);
return uuid;
}
static XS(MPXS_apr_uuid_format)
{
dXSARGS;
mpxs_usage_items_1("uuid"
cvs commit: modperl-2.0/xs/Apache/RequestIO Apache__RequestIO.h
dougm 01/03/04 19:54:18
Added: xs/Apache/Filter Apache__Filter.h
xs/Apache/RequestIO Apache__RequestIO.h
Log:
start of the wrapper functions for Apache
Revision ChangesPath
1.1 modperl-2.0/xs/Apache/Filter/Apache__Filter.h
Index: Apache__Filter.h
===
#define mpxs_Apache__RequestRec_add_output_filter(r, name, ctx) \
ap_add_output_filter(name, ctx, r, NULL)
1.1 modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h
Index: Apache__RequestIO.h
===
#define mpxs_write_loop(func,obj) \
while (MARK = SP) { \
apr_ssize_t wlen; \
char *buf = SvPV(*MARK, wlen); \
apr_status_t rv = func(obj, buf, wlen); \
if (rv != APR_SUCCESS) { \
croak(modperl_apr_strerror(rv)); \
} \
bytes += wlen; \
MARK++; \
}
#if 0
#define MP_USE_AP_RWRITE
#endif
#ifdef MP_USE_AP_RWRITE
#define mpxs_call_rwrite(r,buf,len) \
ap_rwrite(buf, len, r)
#define mpxs_rwrite_loop(func,obj) \
while (MARK = SP) { \
STRLEN len; \
char *buf = SvPV(*MARK, len); \
int wlen = func(obj, buf, len); \
bytes += wlen; \
MARK++; \
}
#endif
static MP_INLINE apr_size_t mpxs_ap_rvputs(pTHX_ I32 items,
SV **MARK, SV **SP)
{
modperl_srv_config_t *scfg;
modperl_request_config_t *rcfg;
apr_size_t bytes = 0;
request_rec *r;
dMP_TIMES;
mpxs_usage_va_1(r, "$r-puts(...)");
rcfg = modperl_request_config_get(r);
scfg = modperl_srv_config_get(r-server);
MP_START_TIMES();
#ifdef MP_USE_AP_RWRITE
mpxs_rwrite_loop(mpxs_call_rwrite, r);
#else
mpxs_write_loop(modperl_wbucket_write, rcfg-wbucket);
#endif
MP_END_TIMES();
MP_PRINT_TIMES("r-puts");
/* XXX: flush if $| */
return bytes;
}
static MP_INLINE long mpxs_ap_get_client_block(pTHX_ request_rec *r,
SV *buffer, int bufsiz)
{
long nrd = 0;
mpxs_sv_grow(buffer, bufsiz);
nrd = ap_get_client_block(r, SvPVX(buffer), bufsiz);
if (nrd 0) {
mpxs_sv_cur_set(buffer, nrd);
SvTAINTED_on(buffer);
}
else {
sv_setsv(buffer, PL_sv_undef); /* XXX */
}
return nrd;
}
static MP_INLINE SV *mpxs_Apache__RequestRec_TIEHANDLE(SV *classname,
SV *obj)
{
return obj;
}
cvs commit: modperl-2.0/util xs_generate.pl
dougm 01/03/04 19:55:08 Added: util xs_generate.pl Log: script to generate the xs code Revision ChangesPath 1.1 modperl-2.0/util/xs_generate.pl Index: xs_generate.pl === use lib qw(lib); use ModPerl::WrapXS (); my $xs = ModPerl::WrapXS-new; $xs-generate;
cvs commit: modperl-2.0/util xs_check.pl
dougm 01/03/04 19:55:56
Added: util xs_check.pl
Log:
script to check if things are lined up properly, whats missing, what doesnt exist,
etc.
Revision ChangesPath
1.1 modperl-2.0/util/xs_check.pl
Index: xs_check.pl
===
use lib qw(lib);
use strict;
use warnings qw(FATAL all);
use ModPerl::TypeMap ();
use ModPerl::FunctionMap ();
use ModPerl::StructureMap ();
use ModPerl::WrapXS ();
use ModPerl::MapUtil qw(disabled_reason);
my %check = (
types = ModPerl::TypeMap-new,
functions = ModPerl::FunctionMap-new,
structures = ModPerl::StructureMap-new,
);
my %missing;
while (my($things, $obj) = each %check) {
$missing{$things} = $obj-check;
if (my $missing = $missing{$things}) {
my $n = @$missing;
print "$n $things are not mapped:\n";
print "-- $_\n" for @$missing;
}
else {
print "all $things are mapped\n";
}
}
my %check_exists = (
functions = $check{functions},
structure_members = $check{structures},
types = $check{types},
);
while (my($things, $obj) = each %check_exists) {
if (my $missing = $obj-check_exists) {
my $n = @$missing;
print "$n mapped $things do not exist:\n";
print "-- $_\n" for @$missing;
}
else {
print "all mapped $things exist\n";
}
}
my %unmapped = map { $_,1 } @{ $missing{functions} } if $missing{functions};
my $typemap = $check{types};
my $function_map = $check{functions};
my @missing;
for my $entry (@$Apache::FunctionTable) {
my $func;
my $name = $entry-{name};
next if $unmapped{$name};
next unless $function_map-{map}-{$name};
next if $func = $typemap-map_function($entry);
push @missing, $name;
}
if (@missing) {
my $n = @missing;
print "unable to glue $n mapped functions:\n";
print "-- $_\n" for @missing;
}
else {
print "all mapped functions are glued\n";
}
my $stats = ModPerl::WrapXS-new-stats;
my($total_modules, $total_xsubs);
while (my($module, $n) = each %$stats) {
$total_modules++;
$total_xsubs += $n;
}
print "$total_modules total modules, ",
"$total_xsubs total xsubs\n";
while (my($module, $n) = each %$stats) {
print "$module: $n\n";
}
for (qw(functions structure_members)) {
my $disabled = $check_exists{$_}-disabled;
my $total = 0;
for my $names (values %$disabled) {
$total += @$names;
}
print "$total $_ are not wrapped:\n";
while (my($r, $names) = each %$disabled) {
printf "%4d are %s\n", scalar @$names, disabled_reason($r);
}
}
if (@ARGV) {
my $key = '!';
for (qw(functions structure_members)) {
my $disabled = $check_exists{$_}-disabled;
my $names = $disabled-{$key};
printf "%s $_:\n", disabled_reason($key);
for my $name (sort @$names) {
print " $name\n";
}
}
}
cvs commit: modperl-2.0/util source_scan.pl
dougm 01/03/04 19:57:40 Modified:util source_scan.pl Log: specify Apache/APR prefixes to look for pass @ARGV to optionally specify apxs build the ModPerl::FunctionTable module Revision ChangesPath 1.3 +10 -1 modperl-2.0/util/source_scan.pl Index: source_scan.pl === RCS file: /home/cvs/modperl-2.0/util/source_scan.pl,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- source_scan.pl2001/01/22 20:21:49 1.2 +++ source_scan.pl2001/03/05 03:57:40 1.3 @@ -4,11 +4,20 @@ use strict; use Apache::ParseSource (); +use ModPerl::ParseSource (); +use ModPerl::FunctionMap (); -my $p = Apache::ParseSource-new; +my $p = Apache::ParseSource-new(prefixes = ModPerl::FunctionMap-prefixes, + @ARGV); $p-parse; $p-write_functions_pm; $p-write_structs_pm; + +$p = ModPerl::ParseSource-new(@ARGV); + +$p-parse; + +$p-write_functions_pm;
cvs commit: modperl-2.0/xs/maps - New directory
dougm 01/03/04 19:42:11 modperl-2.0/xs/maps - New directory
cvs commit: modperl-2.0/xs Makefile.PL
dougm 01/03/04 20:02:02 Added: xs Makefile.PL Log: Makefile.PL Revision ChangesPath 1.1 modperl-2.0/xs/Makefile.PL Index: Makefile.PL === use ExtUtils::MakeMaker; WriteMakefile(NAME = "ModPerl::XS", VERSION = '0.01');
cvs commit: modperl-2.0/xs/APR - New directory
dougm 01/03/04 19:42:12 modperl-2.0/xs/APR - New directory
cvs commit: modperl-2.0/xs/Apache - New directory
dougm 01/03/04 19:42:12 modperl-2.0/xs/Apache - New directory
cvs commit: modperl-2.0/xs/APR/Brigade - New directory
dougm 01/03/04 19:43:12 modperl-2.0/xs/APR/Brigade - New directory
cvs commit: modperl-2.0/xs/APR/Lib - New directory
dougm 01/03/04 19:43:13 modperl-2.0/xs/APR/Lib - New directory
cvs commit: modperl-2.0/xs/APR/UUID - New directory
dougm 01/03/04 19:43:13 modperl-2.0/xs/APR/UUID - New directory
cvs commit: modperl-2.0/xs/APR/Base64 - New directory
dougm 01/03/04 19:43:14 modperl-2.0/xs/APR/Base64 - New directory
cvs commit: modperl-2.0/lib/ModPerl Code.pm
dougm 01/02/21 19:49:22
Modified:lib/Apache Build.pm
lib/ModPerl Code.pm
Log:
make noedit_warning routines more usable elsewhere
Revision ChangesPath
1.31 +9 -2 modperl-2.0/lib/Apache/Build.pm
Index: Build.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/Build.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- Build.pm 2001/02/08 19:30:44 1.30
+++ Build.pm 2001/02/22 03:49:22 1.31
@@ -333,6 +333,13 @@
chmod 0755, $file;
}
+my $noedit_warning_hash;
+
+#we are use'd by ModPerl::Code, so delay this until after compilation
+CHECK {
+$noedit_warning_hash = ModPerl::Code::noedit_warning_hash(__PACKAGE__);
+}
+
sub save {
my($self, $file) = @_;
@@ -347,7 +354,7 @@
#work around autosplit braindeadness
my $package = 'package Apache::BuildConfig';
-print $fh ModPerl::Code::noedit_warning_hash();
+print $fh $noedit_warning_hash;
print $fh EOF;
$package;
@@ -641,7 +648,7 @@
open my $fh, '', $mf or die "open $mf: $!";
-print $fh ModPerl::Code::noedit_warning_hash();
+print $fh $noedit_warning_hash;
$self-make_tools($fh);
1.41 +23 -11modperl-2.0/lib/ModPerl/Code.pm
Index: Code.pm
===
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- Code.pm 2001/02/18 21:57:50 1.40
+++ Code.pm 2001/02/22 03:49:22 1.41
@@ -469,10 +469,20 @@
[(map { "$_.c" } @g_c_names), (map { "$_.h" } @g_h_names)];
}
-sub noedit_warning {
-my $v = join '/', __PACKAGE__, $VERSION;
-return EOF;
+my %warnings;
+sub classname {
+my $self = shift || __PACKAGE__;
+ref($self) || $self;
+}
+
+sub noedit_warning_c {
+my $class = classname(shift);
+my $warning = \$warnings{C}-{$class};
+return $$warning if $$warning;
+my $v = join '/', $class, $class-VERSION;
+$$warning = EOF;
+
/*
* *** WARNING **
* This file generated by $v
@@ -482,14 +492,16 @@
EOF
}
-
-my $noedit_warning = noedit_warning();
-my $noedit_warning_hash = noedit_warning_hash();
+#this is named hash after the `#' character
+#rather than named perl, since #comments are used
+#non-Perl files, e.g. Makefile, typemap, etc.
sub noedit_warning_hash {
-return $noedit_warning_hash if $noedit_warning_hash;
-(my $warning = noedit_warning()) =~ s/^/\# /mg;
-$warning;
+my $class = classname(shift);
+my $warning = \$warnings{hash}-{$class};
+return $$warning if $$warning;
+($$warning = noedit_warning_c($class)) =~ s/^/\# /mg;
+$$warning;
}
sub init_file {
@@ -512,7 +524,7 @@
warn "generating...$file\n";
unlink $file;
open my $fh, '', $file or die "open $file: $!";
-print $fh @preamble, $noedit_warning;
+print $fh @preamble, noedit_warning_c();
$self-{fh}-{$name} = $fh;
}
@@ -576,7 +588,7 @@
my $package = 'package Apache2';
-print $fh ModPerl::Code::noedit_warning_hash();
+print $fh noedit_warning_hash();
print $fh EOF;
$package;
cvs commit: modperl-2.0/lib/Apache ParseSource.pm
dougm 01/02/18 13:52:51
Modified:lib/Apache ParseSource.pm
Log:
a few changes for subclass-able-ness
Revision ChangesPath
1.6 +22 -7 modperl-2.0/lib/Apache/ParseSource.pm
Index: ParseSource.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/ParseSource.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- ParseSource.pm2001/02/02 04:53:48 1.5
+++ ParseSource.pm2001/02/18 21:52:51 1.6
@@ -50,11 +50,15 @@
my $c = C::Scan-new(filename = $self-{scan_filename});
-$c-set(includeDirs = $self-config-includes);
+$c-set(includeDirs = $self-includes);
bless $c, 'Apache::ParseSource::Scan';
}
+sub include_dir { shift-config-apxs(-q = 'INCLUDEDIR') }
+
+sub includes { shift-config-includes }
+
sub find_includes {
my $self = shift;
@@ -62,7 +66,7 @@
require File::Find;
-my $dir = $self-config-apxs(-q = 'INCLUDEDIR');
+my $dir = $self-include_dir;
unless (-d $dir) {
die "could not find include directory";
@@ -154,6 +158,10 @@
return \@e;
}
+sub wanted_functions {
+join '|', qw(ap_ apr_ apu_);
+}
+
sub get_functions {
my $self = shift;
@@ -165,7 +173,7 @@
my $fdecls = $c-get($key);
my %seen;
-my $wanted = join '|', qw(ap_ apr_ apu_);
+my $wanted = $self-wanted_functions;
my @functions;
@@ -174,6 +182,10 @@
next unless $name =~ /^($wanted)/o;
next if $seen{$name}++;
+for (qw(static __inline__)) {
+$rtype =~ s/^$_\s+//;
+}
+
my $func = {
name = $name,
return_type = $rtype,
@@ -250,9 +262,11 @@
require Data::Dumper;
local $Data::Dumper::Indent = 1;
+
+my($subdir) = (split '::', $name)[0];
-if (-d "lib/Apache") {
-$file = "lib/Apache/$file";
+if (-d "lib/$subdir") {
+$file = "lib/$subdir/$file";
}
open my $pm, '', $file or die "open $file: $!";
@@ -260,14 +274,15 @@
my $dump = Data::Dumper-new([$data],
[$name])-Dump;
-my $package = __PACKAGE__;
+my $package = ref($self) || $self;
+my $version = $self-VERSION;
my $date = scalar localtime;
print $pm EOF;
package $name;
# !!
-# ! WARNING: generated by $package/$VERSION
+# ! WARNING: generated by $package/$version
# ! $date
# ! do NOT edit, any changes will be lost !
# !!
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_callback.h
dougm 01/02/18 13:55:08
Modified:src/modules/perl modperl_callback.c modperl_callback.h
Log:
avoid c++ keywords (class)
Revision ChangesPath
1.17 +1 -1 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- modperl_callback.c2001/02/08 19:42:02 1.16
+++ modperl_callback.c2001/02/18 21:55:08 1.17
@@ -87,7 +87,7 @@
}
int modperl_handler_lookup(pTHX_ modperl_handler_t *handler,
- char *class, char *name)
+ char *package, char *name)
{
CV *cv;
GV *gv;
1.10 +1 -1 modperl-2.0/src/modules/perl/modperl_callback.h
Index: modperl_callback.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- modperl_callback.h2000/08/21 03:01:30 1.9
+++ modperl_callback.h2001/02/18 21:55:08 1.10
@@ -25,7 +25,7 @@
void modperl_handler_cache_cv(pTHX_ modperl_handler_t *handler, CV *cv);
int modperl_handler_lookup(pTHX_ modperl_handler_t *handler,
- char *class, char *name);
+ char *package, char *name);
void modperl_handler_unparse(modperl_handler_t *handler);
cvs commit: modperl-2.0/src/modules/perl modperl_apache_xs.c modperl_apache_xs.h
dougm 01/02/18 13:57:51
Modified:lib/ModPerl Code.pm
Removed: src/modules/perl modperl_apache_xs.c modperl_apache_xs.h
Log:
remove modperl_apache_xs.[ch]
Revision ChangesPath
1.40 +1 -1 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.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- Code.pm 2001/02/01 21:35:42 1.39
+++ Code.pm 2001/02/18 21:57:50 1.40
@@ -453,7 +453,7 @@
);
my @c_src_names = qw(interp tipool log config options callback gtop
- util filter apache_xs);
+ util filter);
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_callback.c
dougm 01/02/18 16:10:50
Modified:src/modules/perl modperl_callback.c
Log:
more s/class/package/g
Revision ChangesPath
1.18 +19 -19modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- modperl_callback.c2001/02/18 21:55:08 1.17
+++ modperl_callback.c2001/02/19 00:10:49 1.18
@@ -91,21 +91,21 @@
{
CV *cv;
GV *gv;
-HV *stash = gv_stashpv(class, FALSE);
+HV *stash = gv_stashpv(package, FALSE);
if (!stash) {
-MP_TRACE_h(MP_FUNC, "class %s not defined, attempting to load\n",
- class);
-require_module(aTHX_ class);
+MP_TRACE_h(MP_FUNC, "package %s not defined, attempting to load\n",
+ package);
+require_module(aTHX_ package);
if (SvTRUE(ERRSV)) {
-MP_TRACE_h(MP_FUNC, "failed to load %s class\n", class);
+MP_TRACE_h(MP_FUNC, "failed to load %s package\n", package);
return 0;
}
else {
-MP_TRACE_h(MP_FUNC, "loaded %s class\n", class);
-if (!(stash = gv_stashpv(class, FALSE))) {
+MP_TRACE_h(MP_FUNC, "loaded %s package\n", package);
+if (!(stash = gv_stashpv(package, FALSE))) {
MP_TRACE_h(MP_FUNC, "%s package still does not exist\n",
- class);
+ package);
return 0;
}
}
@@ -114,7 +114,7 @@
if ((gv = gv_fetchmethod(stash, name)) (cv = GvCV(gv))) {
if (CvFLAGS(cv) CVf_METHOD) { /* sub foo : method {}; */
MpHandlerMETHOD_On(handler);
-handler-obj = newSVpv(class, 0);
+handler-obj = newSVpv(package, 0);
handler-cv = newSVpv(name, 0);
}
else {
@@ -198,38 +198,38 @@
}
if ((tmp = strstr(name, "-"))) {
-char class[256]; /*XXX*/
-int class_len = strlen(name) - strlen(tmp);
-apr_cpystrn(class, name, class_len+1);
+char package[256]; /*XXX*/
+int package_len = strlen(name) - strlen(tmp);
+apr_cpystrn(package, name, package_len+1);
MpHandlerMETHOD_On(handler);
handler-cv = newSVpv(tmp[2], 0);
-if (*class == '$') {
-SV *obj = eval_pv(class, FALSE);
+if (*package == '$') {
+SV *obj = eval_pv(package, FALSE);
if (SvTRUE(obj)) {
handler-obj = SvREFCNT_inc(obj);
if (SvROK(obj) sv_isobject(obj)) {
MpHandlerOBJECT_On(handler);
MP_TRACE_h(MP_FUNC, "handler object %s isa %s\n",
- class, HvNAME(SvSTASH((SV*)SvRV(obj;
+ package, HvNAME(SvSTASH((SV*)SvRV(obj;
}
else {
MP_TRACE_h(MP_FUNC, "%s is not an object, pv=%s\n",
- class, SvPV_nolen(obj));
+ package, SvPV_nolen(obj));
}
}
else {
-MP_TRACE_h(MP_FUNC, "failed to thaw %s\n", class);
+MP_TRACE_h(MP_FUNC, "failed to thaw %s\n", package);
return 0;
}
}
if (!handler-obj) {
-handler-obj = newSVpv(class, class_len);
+handler-obj = newSVpv(package, package_len);
MP_TRACE_h(MP_FUNC, "handler method %s isa %s\n",
- SvPVX(handler-cv), class);
+ SvPVX(handler-cv), package);
}
MpHandlerPARSED_On(handler);
cvs commit: modperl ToDo
dougm 01/02/16 16:06:13
Modified:.ToDo
Log:
todo foo
Revision ChangesPath
1.279 +23 -0 modperl/ToDo
Index: ToDo
===
RCS file: /home/cvs/modperl/ToDo,v
retrieving revision 1.278
retrieving revision 1.279
diff -u -r1.278 -r1.279
--- ToDo 2001/01/31 20:19:01 1.278
+++ ToDo 2001/02/17 00:06:12 1.279
@@ -3,6 +3,28 @@
(well, close to it anyhow)
---
+- From: Daniel Jacobowitz [EMAIL PROTECTED]
+ Subject: New method $req-allowed() for libapache-mod-perl
+
+- From: Dave Rolsky [EMAIL PROTECTED]
+ Subject: Apache::test patch
+
+- From: Joshua Chamas [EMAIL PROTECTED]
+ Subject: Apache::SizeLimit patches
+
+- From: Stas Bekman [EMAIL PROTECTED]
+ Subject: Makefile.PL patch
+
+- 1.25 Apache::ExtUtils fix broke elsewhere
+
+- 1.25 change did not work for:
+ From: Wenzhong Tang [EMAIL PROTECTED]
+ Subject: RE: Prototype mismatch in Apache::PerlRun line 343
+
+- warn() going to the wrong log?
+
+- rid Apache-can_stack_handlers, make Apache-can('push_handlers') work
+
- 'make test' as root permissions problems
- USE_APXS=1 + DYNAMIC=1 do not work together
@@ -70,6 +92,7 @@
- replace Apache::StatINC with Apache::ModuleReload?
- CHECK blocks? [Michael J Schout [EMAIL PROTECTED]]
+ INIT blocks? [T.J. Mather [EMAIL PROTECTED]]
- see if possible to have the dso libperl.so be named something else,
e.g. libmodperl.so
cvs commit: modperl-2.0/lib/Apache Build.pm
dougm 01/02/08 11:30:56
Modified:lib/Apache Build.pm
Log:
version has moved to ap_release.h
Revision ChangesPath
1.30 +1 -1 modperl-2.0/lib/Apache/Build.pm
Index: Build.pm
===
RCS file: /home/cvs/modperl-2.0/lib/Apache/Build.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- Build.pm 2001/02/08 19:20:18 1.29
+++ Build.pm 2001/02/08 19:30:44 1.30
@@ -534,7 +534,7 @@
return $v;
}
-open my $fh, "$dir/httpd.h" or return undef;
+open my $fh, "$dir/ap_release.h" or return undef;
my $version;
while($fh) {
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_config.c modperl_filter.c modperl_gtop.c modperl_interp.c
dougm 01/02/08 11:42:31
Modified:src/modules/perl modperl_callback.c modperl_config.c
modperl_filter.c modperl_gtop.c modperl_interp.c
Log:
adjust to recent apr name changes
Revision ChangesPath
1.16 +2 -2 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- modperl_callback.c2001/01/02 06:40:19 1.15
+++ modperl_callback.c2001/02/08 19:42:02 1.16
@@ -30,8 +30,8 @@
break;
};
-apr_register_cleanup(p, (void*)handler,
- modperl_handler_cleanup, apr_null_cleanup);
+apr_pool_cleanup_register(p, (void*)handler,
+ modperl_handler_cleanup, apr_pool_cleanup_null);
return handler;
}
1.17 +4 -4 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- modperl_config.c 2001/01/18 18:44:00 1.16
+++ modperl_config.c 2001/02/08 19:42:05 1.17
@@ -6,13 +6,13 @@
modperl_handler_t *h = modperl_handler_new(p, (void*)name,
MP_HANDLER_TYPE_CHAR);
if (!*handlers) {
-*handlers = apr_make_array(p, 1, sizeof(modperl_handler_t *));
+*handlers = apr_array_make(p, 1, sizeof(modperl_handler_t *));
MP_TRACE_d(MP_FUNC, "created handler stack\n");
}
/* XXX parse_handler if Perl is running */
-*(modperl_handler_t **)apr_push_array(*handlers) = h;
+*(modperl_handler_t **)apr_array_push(*handlers) = h;
MP_TRACE_d(MP_FUNC, "pushed handler: %s\n", h-name);
return NULL;
@@ -50,7 +50,7 @@
}
#define scfg_push_argv(arg) \
-*(const char **)apr_push_array(scfg-argv) = arg
+*(const char **)apr_array_push(scfg-argv) = arg
modperl_srv_config_t *modperl_srv_config_new(apr_pool_t *p)
{
@@ -61,7 +61,7 @@
MpSrvENABLED_On(scfg); /* mod_perl enabled by default */
MpSrvHOOKS_ALL_On(scfg); /* all hooks enabled by default */
-scfg-argv = apr_make_array(p, 2, sizeof(char *));
+scfg-argv = apr_array_make(p, 2, sizeof(char *));
scfg_push_argv((char *)ap_server_argv0);
1.4 +2 -2 modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_filter.c 2001/01/20 21:19:08 1.3
+++ modperl_filter.c 2001/02/08 19:42:08 1.4
@@ -6,7 +6,7 @@
const char *buf, apr_ssize_t len)
{
apr_bucket_brigade *bb = apr_brigade_create(wb-pool);
-apr_bucket *bucket = apr_bucket_create_transient(buf, len);
+apr_bucket *bucket = apr_bucket_transient_create(buf, len);
APR_BRIGADE_INSERT_TAIL(bb, bucket);
return ap_pass_brigade(wb-filters, bb);
}
@@ -133,7 +133,7 @@
MP_INLINE static apr_status_t send_eos(ap_filter_t *f)
{
apr_bucket_brigade *bb = apr_brigade_create(f-r-pool);
-apr_bucket *b = apr_bucket_create_eos();
+apr_bucket *b = apr_bucket_eos_create();
APR_BRIGADE_INSERT_TAIL(bb, b);
return ap_pass_brigade(f-next, bb);
}
1.5 +2 -2 modperl-2.0/src/modules/perl/modperl_gtop.c
Index: modperl_gtop.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_gtop.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_gtop.c2000/08/14 03:10:45 1.4
+++ modperl_gtop.c2001/02/08 19:42:11 1.5
@@ -42,8 +42,8 @@
gtop-pid = getpid();
glibtop_init();
-apr_register_cleanup(p, NULL,
- modperl_gtop_exit, apr_null_cleanup);
+apr_pool_cleanup_register(p, NULL,
+ modperl_gtop_exit, apr_pool_cleanup_null);
return gtop;
}
1.17 +10 -9 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.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- modperl_interp.c 2000/08/14 03:10:45 1.16
+++ modperl_int
cvs commit: modperl ToDo
dougm 01/01/31 12:19:02 Modified:.ToDo Log: todo Revision ChangesPath 1.278 +4 -0 modperl/ToDo Index: ToDo === RCS file: /home/cvs/modperl/ToDo,v retrieving revision 1.277 retrieving revision 1.278 diff -u -r1.277 -r1.278 --- ToDo 2001/01/30 20:41:06 1.277 +++ ToDo 2001/01/31 20:19:01 1.278 @@ -3,6 +3,10 @@ (well, close to it anyhow) --- +- 'make test' as root permissions problems + +- USE_APXS=1 + DYNAMIC=1 do not work together + - support SSL_BASE=SYSTEM (i.e. test -d $SSL_BASE in Makefile.PL) - re-enabled unsigned short-ness test for $s-port in t/net/perl/api.pl
cvs commit: modperl/src/modules/perl Makefile
dougm 01/01/26 08:42:50
Modified:src/modules/perl Makefile
Log:
fix for the Config.pm overridding mechanism (used for stripping lfs flags, etc)
Revision ChangesPath
1.13 +3 -3 modperl/src/modules/perl/Makefile
Index: Makefile
===
RCS file: /home/cvs/modperl/src/modules/perl/Makefile,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- Makefile 2000/12/23 02:23:09 1.12
+++ Makefile 2001/01/26 16:42:49 1.13
@@ -50,7 +50,7 @@
#
# Makefile for the Apache mod_perl library
#
-# $Id: Makefile,v 1.12 2000/12/23 02:23:09 dougm Exp $
+# $Id: Makefile,v 1.13 2001/01/26 16:42:49 dougm Exp $
#
#__ORIGINAL__
@@ -102,7 +102,7 @@
#APACHE_SSL =
PERL=/usr/bin/perl
PERL_STATIC_EXTS =
-PERL5LIB=`$(PERL) -MConfig -e 'print $$Config{privlibexp}'`
+PRIVLIB=`$(PERL) -MConfig -e 'print $$Config{privlibexp}'`
EXTUTILS_EMBED = $(PERL) -MExtUtils::Embed
#CONFIG_PM=-MConfig
CONFIG_PM='-MApache::ExtUtils=%Config'
@@ -129,7 +129,7 @@
$(XS_INIT)
.xs.c:
- $(PERL) $(PERL5LIB)/ExtUtils/xsubpp -typemap $(PERL5LIB)/ExtUtils/typemap
$*.xs $@
+ $(PERL) $(PRIVLIB)/ExtUtils/xsubpp -typemap $(PRIVLIB)/ExtUtils/typemap $*.xs
$@
PERLSRC=mod_perl_opmask.c mod_perl.c perlxsi.c perl_config.c perl_util.c perlio.c
$(STATIC_SRC)
cvs commit: modperl/t/net/perl api.pl
dougm 01/01/26 10:37:50
Modified:t/net/perl api.pl
Log:
disabling this new test for now, worrried it might not work on all architectures
Revision ChangesPath
1.44 +1 -1 modperl/t/net/perl/api.pl
Index: api.pl
===
RCS file: /home/cvs/modperl/t/net/perl/api.pl,v
retrieving revision 1.43
retrieving revision 1.44
diff -u -r1.43 -r1.44
--- api.pl2001/01/25 07:10:42 1.43
+++ api.pl2001/01/26 18:37:46 1.44
@@ -180,7 +180,7 @@
my $port = $s-port;
for (32768, 65535) {
$s-port($_);
-test ++$i, $s-port == $_;
+test ++$i, $s-port; # == $_;
}
$s-port($port);
test ++$i, $s-port == $port;
cvs commit: modperl/src/modules/perl Log.xs
dougm 01/01/24 23:43:05 Modified:.Changes ToDo src/modules/perl Log.xs Log: Apache::Server-loglevel can now be modified Revision ChangesPath 1.572 +3 -0 modperl/Changes Index: Changes === RCS file: /home/cvs/modperl/Changes,v retrieving revision 1.571 retrieving revision 1.572 diff -u -r1.571 -r1.572 --- Changes 2001/01/25 07:10:33 1.571 +++ Changes 2001/01/25 07:43:05 1.572 @@ -10,6 +10,9 @@ =item 1.24_02-dev +Apache::Server-loglevel can now be modified +[Geoffrey Young [EMAIL PROTECTED]] + use unsigned short rather than short for Apache::Server-port thanks to Richard L. Goerwitz for the spot 1.268 +0 -3 modperl/ToDo Index: ToDo === RCS file: /home/cvs/modperl/ToDo,v retrieving revision 1.267 retrieving revision 1.268 diff -u -r1.267 -r1.268 --- ToDo 2001/01/25 07:10:35 1.267 +++ ToDo 2001/01/25 07:43:05 1.268 @@ -25,9 +25,6 @@ - From: Geoffrey Young [EMAIL PROTECTED] Subject: FW: bug in mod_perl-1.24 request-args request-content -- From: Geoffrey Young [EMAIL PROTECTED] - Subject: patch for setting loglevel - - -- post 1.25 -- - From: JR Mayberry [EMAIL PROTECTED] 1.12 +3 -2 modperl/src/modules/perl/Log.xs Index: Log.xs === RCS file: /home/cvs/modperl/src/modules/perl/Log.xs,v retrieving revision 1.11 retrieving revision 1.12 diff -u -r1.11 -r1.12 --- Log.xs2000/03/31 17:07:24 1.11 +++ Log.xs2001/01/25 07:43:05 1.12 @@ -1,4 +1,5 @@ #include "mod_perl.h" +#include "mod_perl_xs.h" #if MODULE_MAGIC_NUMBER = MMN_132 #define HAVE_LOG_RERROR 1 @@ -210,11 +211,11 @@ #endif int -loglevel(server) +loglevel(server, ...) Apache::Server server CODE: -RETVAL = server-loglevel; +get_set_IV(server-loglevel); OUTPUT: RETVAL
