perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/todo filters.txt
Date Thu, 17 Apr 2003 08:04:48 GMT
stas        2003/04/17 01:04:47

  Modified:    xs/Apache/Filter Apache__Filter.h
               src/modules/perl modperl_types.h modperl_mgv.c
                        modperl_filter.h modperl_filter.c
               .        Changes
               todo     filters.txt
  Added:       t/filter in_init_basic.t out_init_basic.t
               t/filter/TestFilter in_init_basic.pm out_init_basic.pm
  Log:
  implement init filter handlers + tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/filter/in_init_basic.t
  
  Index: in_init_basic.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  use Apache::TestUtil;
  
  plan tests => 1;
  
  my $content = "content ok\n";
  my $expected = join '', $content, "init 1\n", "run 2\n";
  
  my $location = '/TestFilter::in_init_basic';
  my $response = POST_BODY $location, content => $content;
  ok t_cmp($expected, $response, "test filter init functionality");
  
  
  
  1.1                  modperl-2.0/t/filter/out_init_basic.t
  
  Index: out_init_basic.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestRequest;
  use Apache::TestUtil;
  
  plan tests => 1;
  
  my $content = "content ok\n";
  my $expected = join '', "init 1\n", "run 1\n", $content, "run 2\n", "run 3\n";
  
  my $location = '/TestFilter::out_init_basic';
  my $response = POST_BODY $location, content => $content;
  ok t_cmp($expected, $response, "test filter init functionality");
  
  
  
  1.1                  modperl-2.0/t/filter/TestFilter/in_init_basic.pm
  
  Index: in_init_basic.pm
  ===================================================================
  package TestFilter::in_init_basic;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  
  use base qw(Apache::Filter);
  
  use Apache::Const -compile => qw(OK M_POST);
  
  use constant READ_SIZE  => 1024;
  
  
  # this filter is expected to be called once
  # it'll set a note, with the count
  sub init : FilterInitHandler {
      my $filter = shift;
  
      my $ctx = $filter->ctx;
      $ctx->{init}++;
      $filter->r->notes->set(init => $ctx->{init});
      $filter->ctx($ctx);
  
      return Apache::OK;
  }
  
  # this filter passes the data through unmodified and sets a note
  # counting how many times it was invoked
  sub transparent : FilterRequestHandler
                    FilterHasInitHandler(\&init)
      {
      my ($filter, $bb, $mode, $block, $readbytes) = @_;
  
      my $ctx = $filter->ctx;
      $ctx->{run}++;
      $filter->r->notes->set(run => $ctx->{run});
      $filter->ctx($ctx);
  
      my $rv = $filter->next->get_brigade($bb, $mode, $block, $readbytes);
      return $rv unless $rv == APR::SUCCESS;
  
      return Apache::OK;
  }
  
  sub response {
      my $r = shift;
  
      $r->content_type('text/plain');
  
      if ($r->method_number == Apache::M_POST) {
          $r->print(ModPerl::Test::read_post($r));
      }
  
      my @keys = qw(init run);
      my %times = map { $_ => $r->notes->get($_)||0 } @keys;
      $r->print("$_ $times{$_}\n") for @keys;
  
      Apache::OK;
  }
  1;
  __DATA__
  SetHandler modperl
  PerlModule             TestFilter::in_init_basic
  PerlResponseHandler    TestFilter::in_init_basic::response
  PerlInputFilterHandler TestFilter::in_init_basic::transparent
  
  
  
  1.1                  modperl-2.0/t/filter/TestFilter/out_init_basic.pm
  
  Index: out_init_basic.pm
  ===================================================================
  package TestFilter::out_init_basic;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  
  use Apache::RequestRec ();
  use Apache::RequestIO ();
  
  use base qw(Apache::Filter);
  
  use Apache::Const -compile => qw(OK M_POST);
  
  use constant READ_SIZE  => 1024;
  
  # this filter is expected to be called once
  # it'll set a note, with the count
  sub init : FilterInitHandler {
      my $filter = shift;
  
      #warn "**** init was invoked\n";
  
      my $ctx = $filter->ctx;
      $ctx->{init}++;
      $filter->r->notes->set(init => $ctx->{init});
      $filter->ctx($ctx);
  
      #warn "**** init is exiting\n";
  
      return Apache::OK;
  }
  
  # testing whether we can get the pre handler callback in evolved way
  sub get_pre_handler { return \&TestFilter::out_init_basic::init }
  
  # this filter adds a count for each time it is invoked
  sub transparent : FilterRequestHandler
                    FilterHasInitHandler(get_pre_handler())
      {
      my ($filter, $bb) = @_;
  
      #warn "**** filter was invoked\n";
  
      my $ctx = $filter->ctx;
  
      $filter->print('run ', ++$ctx->{run}, "\n");
  
      $filter->ctx($ctx);
  
      my $rv = $filter->next->pass_brigade($bb);
      return $rv unless $rv == APR::SUCCESS;
  
      #warn "**** filter is exiting\n";
  
      return Apache::OK;
  }
  
  sub response {
      my $r = shift;
  
      #warn "**** content was invoked\n";
  
      $r->content_type('text/plain');
  
      my $data;
      if ($r->method_number == Apache::M_POST) {
          $data = ModPerl::Test::read_post($r);
      }
  
      $r->print('init ', $r->notes->get('init'), "\n");
      $r->print($data) if $data;
  
      #warn "**** content is exiting\n";
  
      Apache::OK;
  }
  1;
  __DATA__
  SetHandler modperl
  PerlModule             TestFilter::out_init_basic
  PerlResponseHandler    TestFilter::out_init_basic::response
  PerlOutputFilterHandler TestFilter::out_init_basic::transparent
  
  
  
  1.29      +33 -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.28
  retrieving revision 1.29
  diff -u -r1.28 -r1.29
  --- Apache__Filter.h	4 Apr 2003 00:08:37 -0000	1.28
  +++ Apache__Filter.h	17 Apr 2003 08:04:47 -0000	1.29
  @@ -76,6 +76,22 @@
   #define trace_attr()
   #endif
   
  +/* we can't eval at this stage, since the package is not compiled yet,
  + * we are still parsing the source.
  + */
  +#define MODPERL_FILTER_ATTACH_ATTR_CODE(cv, string, len)   \
  +{                                                     \
  +    char *str;                                        \
  +    len -= 2;        /* s/ \( | \) //x       */       \
  +    string++;        /* skip the opening '(' */       \
  +    New(0, str, len+1, char);                         \
  +    Copy(string, str, len+1, char);                   \
  +    str[len] = '\0'; /* remove the closing ')' */     \
  +    sv_magic(cv, Nullsv, '~', NULL, -1);              \
  +    SvMAGIC(cv)->mg_ptr = str;                        \
  +}
  +    
  +
   static XS(MPXS_modperl_filter_attributes)
   {
       dXSARGS;
  @@ -101,6 +117,22 @@
                   trace_attr();
                   continue;
               }
  +          case 'I':
  +            if (strEQ(pv, "InitHandler")) {
  +                *attrs |= MP_FILTER_INIT_HANDLER;
  +                trace_attr();
  +                continue;
  +            }
  +          case 'H':
  +            if (strnEQ(pv, "HasInitHandler", 14)) {
  +                STRLEN code_len;
  +                pv += 14; /* skip over the attr name */
  +                code_len = len - (pv - attribute);
  +                MODPERL_FILTER_ATTACH_ATTR_CODE(SvRV(ST(1)), pv, code_len);
  +                *attrs |= MP_FILTER_HAS_INIT_HANDLER;
  +                trace_attr();
  +                continue;
  +            }
             case 'R':
               if (strEQ(pv, "RequestHandler")) {
                   *attrs |= MP_FILTER_REQUEST_HANDLER;
  @@ -108,6 +140,7 @@
                   continue;
               }
             default:
  +            /* XXX: there could be more than one attr to pass through */
               XPUSHs_mortal_pv(attribute);
               XSRETURN(1);
           }
  
  
  
  1.66      +6 -3      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.65
  retrieving revision 1.66
  diff -u -r1.65 -r1.66
  --- modperl_types.h	25 Jan 2003 03:08:04 -0000	1.65
  +++ modperl_types.h	17 Apr 2003 08:04:47 -0000	1.66
  @@ -158,13 +158,16 @@
       modperl_mgv_t *next;
   };
   
  -typedef struct {
  +typedef struct modperl_handler_t modperl_handler_t;
  +
  +struct modperl_handler_t{
       modperl_mgv_t *mgv_obj;
       modperl_mgv_t *mgv_cv;
  -    const char *name; /* orignal name from .conf if any */
  +    const char *name; /* original name from .conf if any */
       U8 flags;
       U32 attrs;
  -} modperl_handler_t;
  +    modperl_handler_t *next;
  +};
   
   #define MP_HANDLER_TYPE_CHAR 1
   #define MP_HANDLER_TYPE_SV   2
  
  
  
  1.25      +9 -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.24
  retrieving revision 1.25
  diff -u -r1.24 -r1.25
  --- modperl_mgv.c	4 Apr 2003 06:13:22 -0000	1.24
  +++ modperl_mgv.c	17 Apr 2003 08:04:47 -0000	1.25
  @@ -181,6 +181,13 @@
   }
   #endif
   
  +/* currently used for complex filters attributes parsing */
  +/* XXX: may want to generalize it for any handlers */
  +#define MODPERL_MGV_DEEP_RESOLVE(handler, p) \
  +    if (handler->attrs & MP_FILTER_HAS_INIT_HANDLER) { \
  +        modperl_filter_resolve_init_handler(aTHX_ handler, p); \
  +    }
  +
   int modperl_mgv_resolve(pTHX_ modperl_handler_t *handler,
                           apr_pool_t *p, const char *name, int logfailure)
   {
  @@ -247,6 +254,7 @@
                   modperl_mgv_compile(aTHX_ p, HvNAME(GvSTASH(CvGV(cv))));
               modperl_mgv_append(aTHX_ p, handler->mgv_cv, GvNAME(CvGV(cv)));
               MpHandlerPARSED_On(handler);
  +            MODPERL_MGV_DEEP_RESOLVE(handler, p);
               return 1;
           }
       }
  @@ -288,6 +296,7 @@
           MP_TRACE_h(MP_FUNC, "found `%s' in class `%s' as a %s\n",
                      handler_name, HvNAME(stash),
                      MpHandlerMETHOD(handler) ? "method" : "function");
  +        MODPERL_MGV_DEEP_RESOLVE(handler, p);
           return 1;
       }
   
  
  
  
  1.23      +6 -2      modperl-2.0/src/modules/perl/modperl_filter.h
  
  Index: modperl_filter.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.h,v
  retrieving revision 1.22
  retrieving revision 1.23
  diff -u -r1.22 -r1.23
  --- modperl_filter.h	3 Apr 2003 06:23:53 -0000	1.22
  +++ modperl_filter.h	17 Apr 2003 08:04:47 -0000	1.23
  @@ -9,7 +9,9 @@
   
   #define MP_FILTER_CONNECTION_HANDLER 0x01
   #define MP_FILTER_REQUEST_HANDLER    0x02
  -#define MP_FILTER_HTTPD_HANDLER      0x04 
  +#define MP_FILTER_HAS_INIT_HANDLER   0x04 
  +#define MP_FILTER_INIT_HANDLER       0x08 
  +#define MP_FILTER_HTTPD_HANDLER      0x10 
   
   typedef ap_filter_t * MP_FUNC_T(modperl_filter_add_t) (const char *, void *,
                                                          request_rec *,
  @@ -39,6 +41,9 @@
   
   modperl_filter_t *modperl_filter_mg_get(pTHX_ SV *obj);
   
  +int modperl_filter_resolve_init_handler(pTHX_ modperl_handler_t *handler,
  +                                        apr_pool_t *p);
  +
   int modperl_run_filter(modperl_filter_t *filter);
   
   /* output filters */
  @@ -90,6 +95,5 @@
                                   const char *name,
                                   modperl_filter_add_t addfunc,
                                   SV *callback, const char *type);
  -
   
   #endif /* MODPERL_FILTER_H */
  
  
  
  1.61      +135 -6    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.60
  retrieving revision 1.61
  diff -u -r1.60 -r1.61
  --- modperl_filter.c	8 Apr 2003 07:41:51 -0000	1.60
  +++ modperl_filter.c	17 Apr 2003 08:04:47 -0000	1.61
  @@ -253,6 +253,102 @@
       return mg ? (modperl_filter_t *)mg->mg_ptr : NULL;
   }
   
  +/* eval "package Foo; \&init_handler" */
  +int modperl_filter_resolve_init_handler(pTHX_ modperl_handler_t *handler,
  +                                        apr_pool_t *p)
  +{
  +    char *init_handler_pv_code;
  +    char *package_name;
  +    CV *cv;
  +    MAGIC *mg;
  +    
  +    if (handler->mgv_cv) {
  +        GV *gv;
  +        if ((gv = modperl_mgv_lookup(aTHX_ handler->mgv_cv))) {
  +            cv = modperl_mgv_cv(gv);
  +            package_name = modperl_mgv_as_string(aTHX_ handler->mgv_cv, p, 1);
  +            /* fprintf(stderr, "PACKAGE: %s\n", package_name ); */
  +        }
  +    }
  +
  +    if (cv && SvMAGICAL(cv)) {
  +        mg = mg_find((SV*)(cv), '~');
  +        init_handler_pv_code = mg ? mg->mg_ptr : NULL;
  +    }
  +    else {
  +        /* XXX: should we complain in such a case? */
  +        return 0;
  +    }
  +    
  +    if (init_handler_pv_code) {
  +        /* eval the code in the parent handler's package's context */
  +        char *code = apr_pstrcat(p, "package ", package_name, ";",
  +                                 init_handler_pv_code, NULL);
  +        SV *sv = eval_pv(code, TRUE);
  +        char *init_handler_name;
  +
  +        /* fprintf(stderr, "code: %s\n", code); */
  +        
  +        if ((init_handler_name = modperl_mgv_name_from_sv(aTHX_ p, sv))) {
  +            modperl_handler_t *init_handler =
  +                modperl_handler_new(p, apr_pstrdup(p, init_handler_name));
  +
  +            MP_TRACE_h(MP_FUNC, "found init handler %s\n",
  +                       init_handler->name);
  +
  +            if (! init_handler->attrs & MP_FILTER_INIT_HANDLER) {
  +                Perl_croak(aTHX_ "handler %s doesn't have "
  +                           "the FilterInitHandler attribute set",
  +                           init_handler->name);
  +            }
  +            
  +            handler->next = init_handler;
  +            return 1;
  +        }
  +        else {
  +            Perl_croak(aTHX_ "failed to eval code: %s", code);
  +            
  +        }
  +    }
  +
  +    return 1;
  +}
  +
  +static int modperl_run_filter_init(ap_filter_t *f,
  +                                   modperl_handler_t *handler) 
  +{
  +    AV *args = Nullav;
  +    int status;
  +
  +    request_rec *r = f->r;
  +    conn_rec    *c = f->c;
  +    server_rec  *s = r ? r->server : c->base_server;
  +    apr_pool_t  *p = r ? r->pool : c->pool;
  +
  +    MP_TRACE_h(MP_FUNC, "running filter init handler %s\n", handler->name);
  +            
  +    MP_dINTERP_SELECT(r, c, s);
  +    
  +    modperl_handler_make_args(aTHX_ &args,
  +                              "Apache::Filter", f,
  +                              NULL);
  +
  +    /* XXX: do we need it? */
  +    /* modperl_filter_mg_set(aTHX_ AvARRAY(args)[0], filter); */
  +
  +    if ((status = modperl_callback(aTHX_ handler, p, r, s, args)) != OK) {
  +        status = modperl_errsv(aTHX_ status, r, s);
  +    }
  +
  +    SvREFCNT_dec((SV*)args);
  +
  +    MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT
  +               "return: %d\n", handler->name, status);
  +    
  +    return status;  
  +}
  +
  +
   int modperl_run_filter(modperl_filter_t *filter)
   {
       AV *args = Nullav;
  @@ -691,7 +787,6 @@
       }
   }
   
  -
   static int modperl_filter_add_connection(conn_rec *c,
                                            int idx,
                                            const char *name,
  @@ -705,6 +800,7 @@
       if ((av = dcfg->handlers_per_dir[idx])) {
           modperl_handler_t **handlers = (modperl_handler_t **)av->elts;
           int i;
  +        ap_filter_t *f;
   
           for (i=0; i<av->nelts; i++) {
               modperl_filter_ctx_t *ctx;
  @@ -726,8 +822,17 @@
   
               ctx = (modperl_filter_ctx_t *)apr_pcalloc(c->pool, sizeof(*ctx));
               ctx->handler = handlers[i];
  -            addfunc(name, (void*)ctx, NULL, c);
   
  +            f = addfunc(name, (void*)ctx, NULL, c);
  +
  +            if (handlers[i]->attrs & MP_FILTER_HAS_INIT_HANDLER &&
  +                handlers[i]->next) {
  +                int status = modperl_run_filter_init(f, handlers[i]->next);
  +                if (status != OK) {
  +                    return status;
  +                }
  +            }
  +            
               MP_TRACE_h(MP_FUNC, "%s handler %s configured (connection)\n",
                          type, handlers[i]->name);
           }
  @@ -799,8 +904,17 @@
   
               ctx = (modperl_filter_ctx_t *)apr_pcalloc(r->pool, sizeof(*ctx));
               ctx->handler = handlers[i];
  -            addfunc(name, (void*)ctx, r, r->connection);
   
  +            f = addfunc(name, (void*)ctx, r, r->connection);
  +
  +            if (handlers[i]->attrs & MP_FILTER_HAS_INIT_HANDLER &&
  +                handlers[i]->next) {
  +                int status = modperl_run_filter_init(f, handlers[i]->next);
  +                if (status != OK) {
  +                    return status;
  +                }
  +            }
  +            
               MP_TRACE_h(MP_FUNC, "%s handler %s configured (%s)\n",
                          type, handlers[i]->name, r->uri);
           }
  @@ -861,11 +975,26 @@
       char *handler_name;
   
       if ((handler_name = modperl_mgv_name_from_sv(aTHX_ pool, callback))) {
  +        ap_filter_t *f;
  +        modperl_handler_t *handler =
  +            modperl_handler_new(pool, apr_pstrdup(pool, handler_name));
           modperl_filter_ctx_t *ctx =
               (modperl_filter_ctx_t *)apr_pcalloc(pool, sizeof(*ctx));
  -        ctx->handler = modperl_handler_new(pool,
  -                                           apr_pstrdup(pool, handler_name));
  -        addfunc(name, (void*)ctx, r, c);
  +
  +        ctx->handler = handler;
  +        f = addfunc(name, (void*)ctx, r, c);
  +
  +        /* has to resolve early so we can check for init functions */ 
  +        if (!modperl_mgv_resolve(aTHX_ handler, pool, handler->name, TRUE)) {
  +            Perl_croak(aTHX_ "unable to resolve handler %s\n", handler->name);
  +        }
  +
  +        if (handler->attrs & MP_FILTER_HAS_INIT_HANDLER && handler->next)
{
  +            int status = modperl_run_filter_init(f, handler->next);
  +            if (status != OK) {
  +                /* XXX */
  +            }
  +        }
           
           MP_TRACE_h(MP_FUNC, "%s handler %s configured (connection)\n",
                      type, name);
  
  
  
  1.174     +2 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.173
  retrieving revision 1.174
  diff -u -r1.173 -r1.174
  --- Changes	17 Apr 2003 01:19:55 -0000	1.173
  +++ Changes	17 Apr 2003 08:04:47 -0000	1.174
  @@ -10,6 +10,8 @@
   
   =item 1.99_09-dev
   
  +implement init filter handlers + tests [Stas]
  +
   improving ModPerl::MethodLookup to:
   - handle more aliased perl XS functions
   - sort the methods map struct so one can use the autogenerated map as is
  
  
  
  1.4       +0 -7      modperl-2.0/todo/filters.txt
  
  Index: filters.txt
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/todo/filters.txt,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- filters.txt	1 Apr 2003 05:20:50 -0000	1.3
  +++ filters.txt	17 Apr 2003 08:04:47 -0000	1.4
  @@ -99,13 +99,6 @@
   modperl {get,set,push}_handlers api just like other Perl*Handlers
   
   
  -Other issues
  ------------------------
  -- Currently there is no way to MIX & MATCH mod-perl FILTERS declared
  -  via "PerlOutputFilterHandler" with APACHE standard ones.
  -
  -- we also may need filter_init hook
  -
   tie handle interface
   --------------------
   both input/output filters should provide a tiehandle and/or perlio
  
  
  

Mime
View raw message