httpd-apreq-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From j...@apache.org
Subject svn commit: r164622 - in /httpd/apreq/trunk: CHANGES STATUS glue/perl/lib/Apache2/Request.pm glue/perl/t/apreq/request.t glue/perl/t/response/TestApReq/request.pm glue/perl/xsbuilder/APR/Request/APR__Request.h glue/perl/xsbuilder/APR/Request/Request.xs
Date Mon, 25 Apr 2005 18:44:17 GMT
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 = $@->{_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:
     {



Mime
View raw message