You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2001/01/02 07:40:20 UTC
cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h modperl_apache_xs.c modperl_apache_xs.h modperl_callback.c modperl_config.h modperl_types.h modperl_util.c modperl_util.h
dougm 01/01/01 22:40:20
Modified: lib/Apache Build.pm
lib/ModPerl Code.pm MM.pm
pod modperl_dev.pod
src/modules/perl mod_perl.c mod_perl.h modperl_apache_xs.c
modperl_apache_xs.h modperl_callback.c
modperl_config.h modperl_types.h modperl_util.c
modperl_util.h
Log:
add PerlOutputFilterHandler
maintain PerlResponse buffer across $r->write()s via r->per_request_config
fix include paths for httpd-2.0 reorg
add version component
log $@ if $@ after callbacks
compile with #define PERL_CORE for speed
Revision Changes Path
1.23 +20 -9 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.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- Build.pm 2000/08/21 03:01:27 1.22
+++ Build.pm 2001/01/02 06:40:19 1.23
@@ -85,10 +85,9 @@
my $Wall =
"-Wall -Wmissing-prototypes -Wstrict-prototypes -Wmissing-declarations";
-sub ccopts {
+sub ap_ccopts {
my($self) = @_;
-
- my $ccopts = ExtUtils::Embed::ccopts();
+ my $ccopts = "";
if ($self->{MP_USE_GTOP}) {
$ccopts .= " -DMP_USE_GTOP";
@@ -118,6 +117,12 @@
$ccopts;
}
+sub ccopts {
+ my($self) = @_;
+
+ ExtUtils::Embed::ccopts() . $self->ap_ccopts;
+}
+
sub perl_config {
my($self, $key) = @_;
@@ -382,9 +387,7 @@
for my $src_dir ($self->dir,
$self->default_dir,
- <../apache*/src>,
- <../stronghold*/src>,
- '../src', './src')
+ '../httpd-2.0')
{
next unless (-d $src_dir || -l $src_dir);
next if $seen{$src_dir}++;
@@ -575,7 +578,7 @@
}
my @perl_config_pm =
- qw(cc ld ar rm ranlib lib_ext dlext cccdlflags lddlflags
+ qw(cc cpprun ld ar rm ranlib lib_ext dlext cccdlflags lddlflags
perlpath privlibexp);
sub make_tools {
@@ -674,6 +677,12 @@
.c.o:
$(MODPERL_CC) $(MODPERL_CCFLAGS) -c $<
+.c.cpp:
+ $(MODPERL_CPPRUN) $(MODPERL_CCFLAGS) -c $< > $*.cpp
+
+.c.s:
+ $(MODPERL_CC) -O -S $(MODPERL_CCFLAGS) -c $<
+
.xs.c:
$(MODPERL_XSUBPP) $*.xs >$@
@@ -686,7 +695,7 @@
$(MODPERL_CC) $(MP_CCFLAGS_SHLIB) -c $*.c && mv $*.o $*.lo
clean:
- $(MODPERL_RM_F) *.a *.so *.xsc *.o *.lo \
+ $(MODPERL_RM_F) *.a *.so *.xsc *.o *.lo *.cpp *.s \
$(MODPERL_CLEAN_FILES) \
$(MODPERL_XS_CLEAN_FILES)
@@ -738,7 +747,9 @@
my @inc = ();
for ("$src/modules/perl", "$src/include",
- "$src/lib/apr/include", "$src/os/$os",
+ "$src/srclib/apr/include",
+ "$src/srclib/apr-util/include",
+ "$src/os/$os",
$self->file_path("src/modules/perl"))
{
push @inc, "-I$_" if -d $_;
1.35 +16 -8 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.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- Code.pm 2000/08/21 03:01:28 1.34
+++ Code.pm 2001/01/02 06:40:19 1.35
@@ -2,6 +2,7 @@
use strict;
use warnings;
+use mod_perl ();
use Apache::Build ();
our $VERSION = '0.01';
@@ -13,14 +14,14 @@
PerSrv => [qw(PostReadRequest Trans)], #Init
PerDir => [qw(HeaderParser
Access Authen Authz
- Type Fixup Response Log)], #Init Cleanup
+ Type Fixup OutputFilter Response Log)], #Init Cleanup
Connection => [qw(PreConnection ProcessConnection)],
);
my %hooks = map { $_, canon_lc($_) }
map { @{ $handlers{$_} } } keys %handlers;
-my %not_ap_hook = map { $_, 1 } qw(response);
+my %not_ap_hook = map { $_, 1 } qw(response output_filter);
my %hook_proto = (
Process => {
@@ -160,19 +161,20 @@
while (my($class, $prototype) = each %{ $self->{hook_proto} }) {
my $callback = canon_func($class, 'callback');
my $return = $prototype->{ret} eq 'void' ? '' : 'return';
- my $i = 0;
+ my $i = -1;
for my $handler (@{ $self->{handlers}{$class} }) {
my $name = canon_func($handler, 'handler');
+ $i++;
if (my $hook = $hooks{$handler}) {
+ next if $not_ap_hook{$hook};
push @register_hooks,
- " ap_hook_$hook($name, NULL, NULL, AP_HOOK_LAST);"
- unless $not_ap_hook{$hook};
+ " ap_hook_$hook($name, NULL, NULL, AP_HOOK_LAST);";
}
my($protostr, $pass) = canon_proto($prototype, $name);
- my $ix = $self->{handler_index}->{$class}->[$i++];
+ my $ix = $self->{handler_index}->{$class}->[$i];
print $h_fh "\n$protostr;\n";
@@ -326,11 +328,17 @@
'm' => 'memory allocations',
'i' => 'interpreter pool management',
'g' => 'Perl runtime interaction',
+ 'f' => 'filters',
);
sub generate_trace {
my($self, $h_fh) = @_;
+ my $dev = '-dev'; #XXX parse Changes
+ my $v = $mod_perl::VERSION;
+ $v =~ s/(\d\d)(\d\d)$/$1 . '_' . $2 . $dev/e;
+ print $h_fh qq(#define MP_VERSION_STRING "mod_perl/$v"\n);
+
my $i = 1;
my @trace = sort keys %trace;
my $opts = join '', @trace;
@@ -443,7 +451,7 @@
);
my @c_src_names = qw(interp tipool log config options callback gtop
- util apache_xs);
+ util filter apache_xs);
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] }
@@ -451,7 +459,7 @@
sub o_pic_files { [map { "$_.lo" } @c_names, @g_c_names] }
my @g_h_names = map { "modperl_$_" } qw(hooks directives flags trace);
-my @h_names = @c_names;
+my @h_names = (@c_names, qw(modperl_types));
sub h_files { [map { "$_.h" } @h_names, @g_h_names] }
sub clean_files {
1.4 +1 -1 modperl-2.0/lib/ModPerl/MM.pm
Index: MM.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/MM.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- MM.pm 2000/06/09 04:30:42 1.3
+++ MM.pm 2001/01/02 06:40:19 1.4
@@ -53,7 +53,7 @@
sub WriteMakefile {
my $build = build_config();
my_import();
- my @opts = (INC => $build->inc);
+ my @opts = (INC => $build->inc, CCFLAGS => $build->ap_ccopts);
my $typemap = $build->file_path('src/modules/perl/typemap');
if (-e $typemap) {
push @opts, TYPEMAPS => [$typemap];
1.6 +2 -0 modperl-2.0/pod/modperl_dev.pod
Index: modperl_dev.pod
===================================================================
RCS file: /home/cvs/modperl-2.0/pod/modperl_dev.pod,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_dev.pod 2000/08/21 03:01:29 1.5
+++ modperl_dev.pod 2001/01/02 06:40:19 1.6
@@ -114,6 +114,8 @@
=item PerlFixupHandler
+=item PerlOutputFilterHandler
+
=item PerlResponseHandler
=item PerlLogHandler
1.22 +60 -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.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- mod_perl.c 2000/08/21 03:01:30 1.21
+++ mod_perl.c 2001/01/02 06:40:19 1.22
@@ -121,16 +121,40 @@
void modperl_pre_config_handler(apr_pool_t *p, apr_pool_t *plog,
apr_pool_t *ptemp)
{
+ /* XXX: htf can we have PerlPreConfigHandler
+ * without first configuring mod_perl ?
+ */
}
+static void modperl_hook_post_config(apr_pool_t *pconf, apr_pool_t *plog,
+ apr_pool_t *ptemp, server_rec *s)
+{
+#ifdef USE_ITHREADS
+ MP_dSCFG(s);
+ dTHXa(scfg->mip->parent->perl);
+#endif
+ ap_add_version_component(pconf, MP_VERSION_STRING);
+ ap_add_version_component(pconf,
+ Perl_form(aTHX_ "Perl/v%vd", PL_patchlevel));
+}
+
void modperl_register_hooks(void)
{
- /* XXX: should be pre_config hook or 1.xx logic */
ap_hook_open_logs(modperl_hook_init, NULL, NULL, AP_HOOK_MIDDLE);
+
+ ap_hook_insert_filter(modperl_output_filter_register,
+ NULL, NULL, AP_HOOK_LAST);
+
+ ap_register_output_filter(MODPERL_OUTPUT_FILTER_NAME,
+ modperl_output_filter_handler,
+ AP_FTYPE_CONTENT);
+
+ ap_hook_post_config(modperl_hook_post_config, NULL, NULL, AP_HOOK_MIDDLE);
+
modperl_register_handler_hooks();
}
-static command_rec modperl_cmds[] = {
+static const command_rec modperl_cmds[] = {
MP_SRV_CMD_ITERATE("PerlSwitches", switches, "Perl Switches"),
MP_SRV_CMD_ITERATE("PerlOptions", options, "Perl Options"),
#ifdef MP_TRACE
@@ -151,8 +175,41 @@
MP_CMD_ENTRIES,
{ NULL },
};
+
+static void modperl_response_init(request_rec *r)
+{
+ MP_dRCFG;
+
+ modperl_request_config_init(r, rcfg);
+
+ /* setup buffer for output */
+ rcfg->wbucket.pool = r->pool;
+ rcfg->wbucket.filters = r->output_filters;
+ rcfg->wbucket.outcnt = 0;
+}
+
+static void modperl_response_finish(request_rec *r)
+{
+ MP_dRCFG;
+
+ /* flush output buffer */
+ modperl_wbucket_flush(&rcfg->wbucket);
+}
+
+static int modperl_response_handler(request_rec *r)
+{
+ int retval;
+
+ modperl_response_init(r);
+
+ retval = modperl_per_dir_callback(MP_RESPONSE_HANDLER, r);
+
+ modperl_response_finish(r);
+
+ return retval;
+}
-static handler_rec modperl_handlers[] = {
+static const handler_rec modperl_handlers[] = {
#if 0
{ "perl-script", modperl_1xx_response_handler },
#endif
1.20 +12 -1 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.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- mod_perl.h 2000/08/21 03:01:30 1.19
+++ mod_perl.h 2001/01/02 06:40:19 1.20
@@ -2,16 +2,25 @@
#define MOD_PERL_H
#ifndef PERL_NO_GET_CONTEXT
-#define PERL_NO_GET_CONTEXT
+# define PERL_NO_GET_CONTEXT
#endif
+#define PERL_CORE
+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#ifdef PERL_CORE
+# ifndef croak
+# define croak Perl_croak_nocontext
+# endif
+#endif
+
#undef dNOOP
#define dNOOP extern int __attribute__ ((unused)) Perl___notused
+#define CORE_PRIVATE
#include "ap_mmn.h"
#include "httpd.h"
#include "http_config.h"
@@ -20,6 +29,7 @@
#include "http_main.h"
#include "http_request.h"
#include "http_connection.h"
+#include "http_core.h"
#include "apr_lock.h"
#include "apr_strings.h"
@@ -44,6 +54,7 @@
#include "modperl_log.h"
#include "modperl_options.h"
#include "modperl_directives.h"
+#include "modperl_filter.h"
void modperl_init(server_rec *s, apr_pool_t *p);
void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog,
1.3 +72 -54 modperl-2.0/src/modules/perl/modperl_apache_xs.c
Index: modperl_apache_xs.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_apache_xs.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_apache_xs.c 2000/08/21 03:43:53 1.2
+++ modperl_apache_xs.c 2001/01/02 06:40:19 1.3
@@ -1,84 +1,102 @@
#include "mod_perl.h"
#include "modperl_apache_xs.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++; \
+ }
+
/*
* it is not optimal to create an ap_bucket for each element of @_
* so we use our own mini-buffer to build up a decent size buffer
* before creating an ap_bucket
+ * this buffer is flushed when full or after PerlResponseHandlers are run
*/
-/*
- * XXX: should make the modperl_wbucket_t hang off of
- * r->per_request_config to avoid "setaside" copies of small buffers
- * that may happen during ap_pass_brigade()
- */
+/* XXX: maybe we should just let xsubpp do its job */
+#define modperl_sv2r modperl_sv2request_rec
-#ifndef MODPERL_WBUCKET_SIZE
-#define MODPERL_WBUCKET_SIZE IOBUFSIZE
-#endif
-
-typedef struct {
- int outcnt;
- char outbuf[MODPERL_WBUCKET_SIZE];
- request_rec *r;
-} modperl_wbucket_t;
+#define mpxs_sv2obj(obj) \
+(obj = modperl_sv2##obj(aTHX_ *MARK++))
-static MP_INLINE void modperl_wbucket_pass(modperl_wbucket_t *b,
- void *buf, int len)
-{
- ap_bucket_brigade *bb = ap_brigade_create(b->r->pool);
- ap_bucket *bucket = ap_bucket_create_transient(buf, len);
- ap_brigade_append_buckets(bb, bucket);
- ap_pass_brigade(b->r->filters, bb);
-}
+#define mpxs_usage(i, obj, msg) \
+if ((items < i) || !(mpxs_sv2obj(obj))) \
+croak("usage: %s", msg)
+
+#define mpxs_usage_1(obj, msg) mpxs_usage(1, obj, msg)
+
+#define mpxs_usage_2(obj, arg, msg) \
+mpxs_usage(2, obj, msg); \
+arg = *MARK++
-static MP_INLINE void modperl_wbucket_flush(modperl_wbucket_t *b)
+MP_INLINE apr_size_t modperl_apache_xs_write(pTHX_ I32 items,
+ SV **MARK, SV **SP)
{
- modperl_wbucket_pass(b, b->outbuf, b->outcnt);
- b->outcnt = 0;
+ modperl_request_config_t *rcfg;
+ apr_size_t bytes = 0;
+ request_rec *r;
+
+ mpxs_usage_1(r, "$r->write(...)");
+
+ rcfg = modperl_request_config_get(r);
+
+ mpxs_write_loop(modperl_wbucket_write, &rcfg->wbucket);
+
+ /* XXX: flush if $| */
+
+ return bytes;
}
-static MP_INLINE void modperl_wbucket_write(modperl_wbucket_t *b,
- void *buf, int len)
+MP_INLINE apr_size_t modperl_filter_xs_write(pTHX_ I32 items,
+ SV **MARK, SV **SP)
{
- if ((len + b->outcnt) > MODPERL_WBUCKET_SIZE) {
- modperl_wbucket_flush(b);
- }
+ modperl_filter_t *filter;
+ apr_size_t bytes = 0;
+
+ mpxs_usage_1(filter, "$filter->write(...)");
- if (len >= MODPERL_WBUCKET_SIZE) {
- modperl_wbucket_pass(b, buf, len);
+ if (filter->mode == MP_OUTPUT_FILTER_MODE) {
+ mpxs_write_loop(modperl_output_filter_write, filter);
+ modperl_output_filter_flush(filter);
}
else {
- memcpy(&b->outbuf[b->outcnt], buf, len);
- b->outcnt += len;
+ croak("input filters not yet supported");
}
+
+ /* XXX: ap_rflush if $| */
+
+ return bytes;
}
-MP_INLINE apr_size_t modperl_apache_xs_write(pTHX_ SV **mark_ptr, SV **sp_ptr)
+MP_INLINE apr_size_t modperl_filter_xs_read(pTHX_ I32 items,
+ SV **MARK, SV **SP)
{
- modperl_wbucket_t wbucket;
- apr_size_t bytes = 0;
-
- mark_ptr++;
+ modperl_filter_t *filter;
+ apr_size_t wanted, len=0;
+ SV *buffer;
- wbucket.r = modperl_sv2request_rec(aTHX_ *mark_ptr++);
- wbucket.outcnt = 0;
+ mpxs_usage_2(filter, buffer, "$filter->read(buf, [len])");
- if (wbucket.r->connection->aborted) {
- return EOF;
+ if (items > 2) {
+ wanted = SvIV(*MARK);
}
-
- while (mark_ptr <= sp_ptr) {
- STRLEN len;
- char *buf = SvPV(*mark_ptr, len);
- modperl_wbucket_write(&wbucket, buf, len);
- bytes += len;
- mark_ptr++;
+ else {
+ wanted = IOBUFSIZE;
}
- modperl_wbucket_flush(&wbucket);
-
- /* XXX: ap_rflush if $| */
+ if (filter->mode == MP_OUTPUT_FILTER_MODE) {
+ len = modperl_output_filter_read(aTHX_ filter, buffer, wanted);
+ }
+ else {
+ croak("input filters not yet supported");
+ }
- return bytes;
+ return len;
}
1.3 +8 -1 modperl-2.0/src/modules/perl/modperl_apache_xs.h
Index: modperl_apache_xs.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_apache_xs.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_apache_xs.h 2000/08/21 03:46:00 1.2
+++ modperl_apache_xs.h 2001/01/02 06:40:19 1.3
@@ -1,6 +1,13 @@
#ifndef MODPERL_APACHE_XS_H
#define MODPERL_APACHE_XS_H
-MP_INLINE apr_size_t modperl_apache_xs_write(pTHX_ SV **mark_ptr, SV **sp_ptr);
+MP_INLINE apr_size_t modperl_apache_xs_write(pTHX_ I32 items,
+ SV **MARK, SV **SP);
+
+MP_INLINE apr_size_t modperl_filter_xs_write(pTHX_ I32 items,
+ SV **MARK, SV **SP);
+
+MP_INLINE apr_size_t modperl_filter_xs_read(pTHX_ I32 items,
+ SV **MARK, SV **SP);
#endif /* MODPERL_APACHE_XS_H */
1.15 +8 -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.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- modperl_callback.c 2000/08/21 03:01:30 1.14
+++ modperl_callback.c 2001/01/02 06:40:19 1.15
@@ -77,9 +77,9 @@
/* handler->cvgen = MP_sub_generation; */;
}
else {
- handler->cv = newSVpvf("%s::%s",
- HvNAME(GvSTASH(CvGV(cv))),
- GvNAME(CvGV(cv)));
+ handler->cv = Perl_newSVpvf(aTHX_ "%s::%s",
+ HvNAME(GvSTASH(CvGV(cv))),
+ GvNAME(CvGV(cv)));
}
MP_TRACE_h(MP_FUNC, "caching %s::%s\n",
HvNAME(GvSTASH(CvGV(cv))),
@@ -437,12 +437,15 @@
};
for (i=0; i<av->nelts; i++) {
+#ifdef USE_ITHREADS
if (!handlers[i]->perl) {
handlers[i]->perl = aTHX;
}
-
+#endif
handlers[i]->args = av_args;
- status = modperl_callback(aTHX_ handlers[i], p);
+ if ((status = modperl_callback(aTHX_ handlers[i], p)) != OK) {
+ status = modperl_errsv(aTHX_ status, r, s);
+ }
handlers[i]->args = Nullav;
MP_TRACE_h(MP_FUNC, "%s returned %d\n",
1.15 +11 -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.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- modperl_config.h 2000/08/14 03:10:45 1.14
+++ modperl_config.h 2001/01/02 06:40:19 1.15
@@ -43,10 +43,18 @@
AP_INIT_ITERATE( name, modperl_cmd_##item, NULL, \
RSRC_CONF, desc )
-#define MP_dRCFG \
- modperl_request_config_t *rcfg = \
- (modperl_request_config_t *) \
+#define modperl_request_config_init(r, rcfg) \
+ if (!rcfg) { \
+ rcfg = modperl_request_config_new(r); \
+ ap_set_module_config(r->request_config, &perl_module, rcfg); \
+ }
+
+#define modperl_request_config_get(r) \
+ (modperl_request_config_t *) \
ap_get_module_config(r->request_config, &perl_module)
+
+#define MP_dRCFG \
+ modperl_request_config_t *rcfg = modperl_request_config_get(r)
#define MP_dDCFG \
modperl_dir_config_t *dcfg = \
1.16 +46 -4 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- modperl_types.h 2000/08/14 03:10:45 1.15
+++ modperl_types.h 2001/01/02 06:40:19 1.16
@@ -23,6 +23,12 @@
/* mod_perl structures */
+typedef struct {
+ request_rec *r;
+ conn_rec *c;
+ server_rec *s;
+} modperl_rcs_t;
+
#ifdef USE_ITHREADS
typedef struct modperl_list_t modperl_list_t;
@@ -143,10 +149,6 @@
} modperl_dir_config_t;
typedef struct {
- HV *pnotes;
-} modperl_request_config_t;
-
-typedef struct {
SV *obj; /* object or classname if cv is a method */
SV *cv; /* subroutine reference or name */
char *name; /* orignal name from .conf if any */
@@ -158,5 +160,45 @@
#define MP_HANDLER_TYPE_CHAR 1
#define MP_HANDLER_TYPE_SV 2
+
+typedef struct {
+ int outcnt;
+ char outbuf[IOBUFSIZE];
+ apr_pool_t *pool;
+ ap_filter_t *filters;
+} modperl_wbucket_t;
+
+typedef enum {
+ MP_INPUT_FILTER_MODE,
+ MP_OUTPUT_FILTER_MODE,
+} modperl_filter_mode_e;
+
+typedef struct {
+ int eos;
+ ap_filter_t *f;
+ char *leftover;
+ apr_ssize_t remaining;
+ modperl_wbucket_t wbucket;
+ ap_bucket *bucket;
+ ap_bucket_brigade *bb;
+ apr_status_t rc;
+ modperl_filter_mode_e mode;
+ apr_pool_t *pool;
+} modperl_filter_t;
+
+typedef modperl_filter_t * Apache__Filter;
+typedef modperl_filter_t * Apache__OutputFilter;
+typedef modperl_filter_t * Apache__InputFilter;
+
+typedef struct {
+ SV *data;
+ modperl_handler_t *handler;
+ PerlInterpreter *perl;
+} modperl_filter_ctx_t;
+
+typedef struct {
+ HV *pnotes;
+ modperl_wbucket_t wbucket;
+} modperl_request_config_t;
#endif /* MODPERL_TYPES_H */
1.2 +38 -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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_util.c 2000/08/21 03:01:58 1.1
+++ modperl_util.c 2001/01/02 06:40:20 1.2
@@ -21,3 +21,41 @@
return sv;
}
+
+char *modperl_apr_strerror(apr_status_t rv)
+{
+ dTHX;
+ char buf[256];
+ apr_strerror(rv, buf, sizeof(buf));
+ return Perl_form(aTHX_ "%d:%s", rv, buf);
+}
+
+int modperl_errsv(pTHX_ int status, request_rec *r, server_rec *s)
+{
+ SV *sv = ERRSV;
+ STRLEN n_a;
+
+ if (SvTRUE(sv)) {
+ if (SvMAGICAL(sv) && (SvCUR(sv) > 4) &&
+ strnEQ(SvPVX(sv), " at ", 4))
+ {
+ /* Apache::exit was called */
+ return DECLINED;
+ }
+#if 0
+ if (modperl_sv_is_http_code(ERRSV, &status)) {
+ return status;
+ }
+#endif
+ if (r) {
+ ap_log_rerror(APLOG_MARK, APLOG_ERR, 0, r, SvPV(sv, n_a));
+ }
+ else {
+ ap_log_error(APLOG_MARK, APLOG_ERR, 0, s, SvPV(sv, n_a));
+ }
+
+ return status;
+ }
+
+ return status;
+}
1.2 +4 -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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_util.h 2000/08/21 03:01:58 1.1
+++ modperl_util.h 2001/01/02 06:40:20 1.2
@@ -14,4 +14,8 @@
#define modperl_bless_request_rec(r) \
modperl_ptr2obj("Apache", r)
+char *modperl_apr_strerror(apr_status_t rv);
+
+int modperl_errsv(pTHX_ int status, request_rec *r, server_rec *s);
+
#endif /* MODPERL_UTIL_H */