Author: joes
Date: Mon Apr 25 11:44:16 2005
New Revision: 164622
URL: http://svn.apache.org/viewcvs?rev=164622&view=rev
Log:
Add UPLOAD_HOOK, and drop HOOK_DATA.
Added:
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h
Modified:
httpd/apreq/trunk/CHANGES
httpd/apreq/trunk/STATUS
httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm
httpd/apreq/trunk/glue/perl/t/apreq/request.t
httpd/apreq/trunk/glue/perl/t/response/TestApReq/request.pm
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs
Modified: httpd/apreq/trunk/CHANGES
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/CHANGES?rev=164622&r1=164621&r2=164622&view=diff
==============================================================================
--- httpd/apreq/trunk/CHANGES (original)
+++ httpd/apreq/trunk/CHANGES Mon Apr 25 11:44:16 2005
@@ -6,6 +6,10 @@
- Perl API [joes]
+ Drop $data argument from UPLOAD_HOOK, and also drop HOOK_DATA option.
+ Perl folks should use a closure instead of passing in context data.
+
+- Perl API [joes]
Move bake, bake2 to Apache2::Cookie, now requiring
an extra $r argument. Also ""-operator is mapped
to as_string() for Apache2::Cookie; but APR::Request::Cookie
Modified: httpd/apreq/trunk/STATUS
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/STATUS?rev=164622&r1=164621&r2=164622&view=diff
==============================================================================
--- httpd/apreq/trunk/STATUS (original)
+++ httpd/apreq/trunk/STATUS Mon Apr 25 11:44:16 2005
@@ -22,8 +22,7 @@
RELEASE SHOWSTOPPERS:
- - The api docs are currently broken, and the perl glue is missing
- UPLOAD_HOOK.
+ - The api docs are currently incorrect.
CURRENT VOTES:
Modified: httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm?rev=164622&r1=164621&r2=164622&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm (original)
+++ httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm Mon Apr 25 11:44:16 2005
@@ -22,12 +22,14 @@
return $req;
}
-sub hook_data {die "hook_data not implemented yet"}
-sub upload_hook {die "upload_hook not implemented yet"}
+sub hook_data {die "hook_data not implemented"}
+sub upload_hook {
+ my ($req, $code) = @_;
+ $req->APR::Request::upload_hook($req->pool, $code);
+}
sub disable_uploads {
- my ($req, $pool) = @_;
- $pool ||= $req->pool;
- $req->APR::Request::disable_uploads($pool);
+ my ($req, $toggle) = @_;
+ $req->APR::Request::disable_uploads($req->pool) if $toggle;
}
1;
Modified: httpd/apreq/trunk/glue/perl/t/apreq/request.t
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/apreq/request.t?rev=164622&r1=164621&r2=164622&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/apreq/request.t (original)
+++ httpd/apreq/trunk/glue/perl/t/apreq/request.t Mon Apr 25 11:44:16 2005
@@ -42,8 +42,6 @@
}
{
- skip 1, "- hook API not yet implemented";
- last;
my $value = 'DataUpload' x 100;
my $result = UPLOAD_BODY("$location?test=hook", content => $value);
ok t_cmp($result, $value, "type");
Modified: httpd/apreq/trunk/glue/perl/t/response/TestApReq/request.pm
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/response/TestApReq/request.pm?rev=164622&r1=164621&r2=164622&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/response/TestApReq/request.pm (original)
+++ httpd/apreq/trunk/glue/perl/t/response/TestApReq/request.pm Mon Apr 25
11:44:16 2005
@@ -125,7 +125,7 @@
}
elsif ($test eq 'hook') {
$data = "";
- $req->config(UPLOAD_HOOK => \&hook);
+ $req->upload_hook(\&hook);
$req->parse;
$r->print($data);
}
@@ -136,7 +136,7 @@
$r->print($upload->type);
}
elsif ($test eq 'disable_uploads') {
- $req->disable_uploads;
+ $req->disable_uploads(1);
eval {my $upload = $req->upload('HTTPUPLOAD')};
if (ref $@ eq "APR::Request::Error") {
my $args = [EMAIL PROTECTED]>{_r}->args('test'); # checks _r is an
object ref
Added: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h?rev=164622&view=auto
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h (added)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h Mon Apr 25
11:44:16 2005
@@ -0,0 +1,128 @@
+static XS(apreq_xs_parse)
+{
+ dXSARGS;
+ apreq_handle_t *req;
+ apr_status_t s;
+ const apr_table_t *t;
+
+ if (items != 1 || !SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: APR::Request::parse($req)");
+
+ req = apreq_xs_sv2handle(aTHX_ ST(0));
+
+ XSprePUSH;
+ EXTEND(SP, 3);
+ s = apreq_jar(req, &t);
+ PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
+ s = apreq_args(req, &t);
+ PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
+ s = apreq_body(req, &t);
+ PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
+ PUTBACK;
+}
+
+struct hook_ctx {
+ SV *hook;
+ SV *bucket_data;
+ SV *parent;
+ PerlInterpreter *perl;
+};
+
+
+#define DEREF(slot) if (ctx->slot) SvREFCNT_dec(ctx->slot)
+
+static apr_status_t upload_hook_cleanup(void *ctx_)
+{
+ struct hook_ctx *ctx = ctx_;
+
+#ifdef USE_ITHREADS
+ dTHXa(ctx->perl);
+#endif
+
+ DEREF(hook);
+ DEREF(bucket_data);
+ DEREF(parent);
+ return APR_SUCCESS;
+}
+
+APR_INLINE
+static apr_status_t eval_upload_hook(pTHX_ apreq_param_t *upload,
+ struct hook_ctx *ctx)
+{
+ dSP;
+ SV *sv = ctx->bucket_data;
+ STRLEN len = SvPOK(sv) ? SvCUR(sv) : 0;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 4);
+ ENTER;
+ SAVETMPS;
+
+ sv = apreq_xs_param2sv(aTHX_ upload, PARAM_CLASS, ctx->parent);
+ PUSHs(sv_2mortal(sv));
+ PUSHs(ctx->bucket_data);
+ PUSHs(sv_2mortal(newSViv(len)));
+
+ PUTBACK;
+ perl_call_sv(ctx->hook, G_EVAL|G_DISCARD);
+ FREETMPS;
+ LEAVE;
+
+ if (SvTRUE(ERRSV)) {
+ Perl_warn(aTHX_ "Upload hook failed: %s", SvPV_nolen(ERRSV));
+ return APREQ_ERROR_GENERAL;
+ }
+ return APR_SUCCESS;
+}
+
+
+static apr_status_t apreq_xs_upload_hook(APREQ_HOOK_ARGS)
+{
+ struct hook_ctx *ctx = hook->ctx; /* ctx set during $req->config */
+ apr_bucket *e;
+ apr_status_t s = APR_SUCCESS;
+#ifdef USE_ITHREADS
+ dTHXa(ctx->perl);
+#endif
+
+ if (bb == NULL) {
+ if (hook->next)
+ return apreq_hook_run(hook->next, param, bb);
+ return APR_SUCCESS;
+ }
+
+ for (e = APR_BRIGADE_FIRST(bb); e!= APR_BRIGADE_SENTINEL(bb);
+ e = APR_BUCKET_NEXT(e))
+ {
+ apr_size_t len;
+ const char *data;
+
+ if (APR_BUCKET_IS_EOS(e)) { /*last call on this upload */
+ SV *sv = ctx->bucket_data;
+ ctx->bucket_data = &PL_sv_undef;
+ s = eval_upload_hook(aTHX_ param, ctx);
+ ctx->bucket_data = sv;
+ if (s != APR_SUCCESS)
+ return s;
+
+ break;
+ }
+
+ s = apr_bucket_read(e, &data, &len, APR_BLOCK_READ);
+ if (s != APR_SUCCESS) {
+ s = APR_SUCCESS;
+ continue;
+ }
+ sv_setpvn(ctx->bucket_data, data, (STRLEN)len);
+ s = eval_upload_hook(aTHX_ param, ctx);
+
+ if (s != APR_SUCCESS)
+ return s;
+
+ }
+
+ if (hook->next)
+ s = apreq_hook_run(hook->next, param, bb);
+
+ return s;
+}
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs
URL:
http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs?rev=164622&r1=164621&r2=164622&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs Mon Apr 25
11:44:16 2005
@@ -1,28 +1,3 @@
-static XS(apreq_xs_parse)
-{
- dXSARGS;
- apreq_handle_t *req;
- apr_status_t s;
- const apr_table_t *t;
-
- if (items != 1 || !SvROK(ST(0)))
- Perl_croak(aTHX_ "Usage: APR::Request::parse($req)");
-
- req = apreq_xs_sv2handle(aTHX_ ST(0));
-
- XSprePUSH;
- EXTEND(SP, 3);
- s = apreq_jar(req, &t);
- PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
- s = apreq_args(req, &t);
- PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
- s = apreq_body(req, &t);
- PUSHs(sv_2mortal(apreq_xs_error2sv(aTHX_ s)));
- PUTBACK;
-}
-
-
-
MODULE = APR::Request PACKAGE = APR::Request
SV*
@@ -224,6 +199,31 @@
OUTPUT:
RETVAL
+
+void
+upload_hook(obj, pool, sub)
+ SV *obj
+ APR::Pool pool
+ SV *sub
+ PREINIT:
+ struct hook_ctx *ctx;
+ IV iv;
+ apreq_handle_t *req;
+ CODE:
+ obj = apreq_xs_sv2object(aTHX_ obj, "APR::Request", 'r');
+ ctx = apr_palloc(pool, sizeof *ctx);
+ ctx->hook = newSVsv(sub);
+ ctx->bucket_data = newSV(8000);
+ ctx->parent = SvREFCNT_inc(obj);
+ SvTAINTED_on(ctx->bucket_data);
+#ifdef USE_ITHREADS
+ ctx->perl = aTHX;
+#endif
+
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+ apreq_hook_add(req, apreq_hook_make(pool, apreq_xs_upload_hook, NULL,
ctx));
+ apr_pool_cleanup_register(pool, ctx, upload_hook_cleanup, NULL);
BOOT:
{
