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 */