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; inelts; 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