perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject 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
Date Tue, 02 Jan 2001 06:40:20 GMT
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 */
  
  
  

Mime
View raw message