[prev in list] [next in list] [prev in thread] [next in thread]
List: apreq-cvs
Subject: svn commit: r164945 - in /httpd/apreq/trunk/glue/perl: lib/Apache2/ t/apreq/
From: joes () apache ! org
Date: 2005-04-27 4:34:20
Message-ID: 20050427043424.69650.qmail () minotaur ! apache ! org
[Download RAW message or body]
Author: joes
Date: Tue Apr 26 21:34:18 2005
New Revision: 164945
URL: http://svn.apache.org/viewcvs?rev=164945&view=rev
Log:
Refactor the XS interfaces for APR::Request::*
and lay down more perldoc placeholders.
Added:
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/CGI/CGI.pod
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pod
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Error/Error.pod
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.pod
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.pod
Modified:
httpd/apreq/trunk/glue/perl/lib/Apache2/Cookie.pm
httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm
httpd/apreq/trunk/glue/perl/t/apreq/cgi.t
httpd/apreq/trunk/glue/perl/t/response/TestAPI/cookie.pm
httpd/apreq/trunk/glue/perl/t/response/TestAPI/error.pm
httpd/apreq/trunk/glue/perl/t/response/TestAPI/module.pm
httpd/apreq/trunk/glue/perl/t/response/TestAPI/param.pm
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Apache2/Apache2.pod
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.xs
httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs
httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_postperl.h
httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_preperl.h
httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_tables.h
httpd/apreq/trunk/glue/perl/xsbuilder/maps/apreq_functions.map
Modified: httpd/apreq/trunk/glue/perl/lib/Apache2/Cookie.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/lib/Apache2/Cookie.pm?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/lib/Apache2/Cookie.pm (original)
+++ httpd/apreq/trunk/glue/perl/lib/Apache2/Cookie.pm Tue Apr 26 21:34:18 2005
@@ -37,7 +37,7 @@
$usage: attempt to fetch global Apache->request failed: $@.
EOD
}
- $req = APR::Request::Apache2->new($req) unless $req->isa("APR::Request");
+ $req = APR::Request::Apache2->handle($req) unless $req->isa("APR::Request");
my $jar = $req->jar or return;
$jar->cookie_class(__PACKAGE__);
return wantarray ? %$jar : $jar;
@@ -103,7 +103,7 @@
sub new {
my $class = shift;
- my $jar = $class->APR::Request::Apache2::new(shift);
+ my $jar = $class->APR::Request::Apache2::handle(shift);
my %attrs = @_;
while (my ($k, $v) = each %attrs) {
$k =~ s/^-//;
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=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm (original)
+++ httpd/apreq/trunk/glue/perl/lib/Apache2/Request.pm Tue Apr 26 21:34:18 2005
@@ -11,7 +11,7 @@
sub new {
my $class = shift;
- my $req = $class->APR::Request::Apache2::new(shift);
+ my $req = $class->APR::Request::Apache2::handle(shift);
my %attrs = @_;
while (my ($k, $v) = each %attrs) {
Modified: httpd/apreq/trunk/glue/perl/t/apreq/cgi.t
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/apreq/cgi.t?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/apreq/cgi.t (original)
+++ httpd/apreq/trunk/glue/perl/t/apreq/cgi.t Tue Apr 26 21:34:18 2005
@@ -218,7 +218,7 @@
my $p = APR::Pool->new();
apreq_log("Creating APR::Request::CGI object");
-my $req = APR::Request::CGI->new($p);
+my $req = APR::Request::CGI->handle($p);
my $foo = $req->param("foo");
my $bar = $req->param("bar");
Modified: httpd/apreq/trunk/glue/perl/t/response/TestAPI/cookie.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/response/TestAPI/cookie.pm?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/response/TestAPI/cookie.pm (original)
+++ httpd/apreq/trunk/glue/perl/t/response/TestAPI/cookie.pm Tue Apr 26 21:34:18 2005
@@ -15,7 +15,7 @@
plan $r, tests => 30;
$r->headers_in->{Cookie} = "foo=1;bar=2;foo=3;quux=4";
- my $req = APR::Request::Apache2->new($r);
+ my $req = APR::Request::Apache2->handle($r);
ok defined $req->jar;
ok t_cmp $req->jar("foo"), 1, "scalar jar(foo)";
Modified: httpd/apreq/trunk/glue/perl/t/response/TestAPI/error.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/response/TestAPI/error.pm?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/response/TestAPI/error.pm (original)
+++ httpd/apreq/trunk/glue/perl/t/response/TestAPI/error.pm Tue Apr 26 21:34:18 2005
@@ -13,7 +13,7 @@
my $r = shift;
plan $r, tests => 3;
- my $req = APR::Request::Apache2->new($r);
+ my $req = APR::Request::Apache2->handle($r);
ok $req->isa("APR::Request");
# XXX export some constants, and test apreq_xs_strerror
Modified: httpd/apreq/trunk/glue/perl/t/response/TestAPI/module.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/response/TestAPI/module.pm?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/response/TestAPI/module.pm (original)
+++ httpd/apreq/trunk/glue/perl/t/response/TestAPI/module.pm Tue Apr 26 21:34:18 2005
@@ -12,7 +12,7 @@
my $r = shift;
plan $r, tests => 9;
- my $req = APR::Request::Apache2->new($r);
+ my $req = APR::Request::Apache2->handle($r);
ok $req->isa("APR::Request::Apache2");
ok t_cmp $req->brigade_limit, 256 * 1024, "default brigade limit is 256K";
Modified: httpd/apreq/trunk/glue/perl/t/response/TestAPI/param.pm
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/t/response/TestAPI/param.pm?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/t/response/TestAPI/param.pm (original)
+++ httpd/apreq/trunk/glue/perl/t/response/TestAPI/param.pm Tue Apr 26 21:34:18 2005
@@ -16,7 +16,7 @@
plan $r, tests => 30;
$r->args("foo=1;bar=2;foo=3;quux=4");
- my $req = APR::Request::Apache2->new($r);
+ my $req = APR::Request::Apache2->handle($r);
ok defined $req->args;
ok t_cmp $req->args("foo"), 1, "scalar args(foo)";
ok t_cmp $req->args("bar"), 2, "scalar args(bar)";
Modified: 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=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/APR__Request.h Tue Apr 26 \
21:34:18 2005 @@ -1,3 +1,312 @@
+#include "apreq_xs_tables.h"
+
+static XS(apreq_xs_jar)
+{
+ dXSARGS;
+ apreq_handle_t *req;
+ SV *sv, *obj;
+ IV iv;
+
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), "APR::Request"))
+ Perl_croak(aTHX_ "Usage: APR::Request::jar($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+
+ if (items == 2 && GIMME_V == G_SCALAR) {
+ apreq_cookie_t *c = apreq_jar_get(req, SvPV_nolen(ST(1)));
+ if (c != NULL) {
+ ST(0) = apreq_xs_cookie2sv(aTHX_ c, NULL, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ else {
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_jar(req, &t);
+ if (apreq_module_status_is_error(s))
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", ERROR_CLASS);
+
+ XSRETURN_UNDEF;
+ }
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_jar(req, &t);
+
+ if (apreq_module_status_is_error(s))
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", ERROR_CLASS);
+
+ if (t == NULL)
+ XSRETURN_EMPTY;
+
+ d.pkg = NULL;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ XSprePUSH;
+ PUTBACK;
+ if (items == 1)
+ apr_table_do(apreq_xs_cookie_table_keys, &d, t, NULL);
+ else
+ apr_table_do(apreq_xs_cookie_table_values, &d, t,
+ SvPV_nolen(ST(1)), NULL);
+ return;
+
+ case G_SCALAR:
+ ST(0) = apreq_xs_cookie_table2sv(aTHX_ t,
+ COOKIE_TABLE_CLASS,
+ obj, NULL, 0);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
+
+
+static XS(apreq_xs_args)
+{
+ dXSARGS;
+ apreq_handle_t *req;
+ SV *sv, *obj;
+ IV iv;
+
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), HANDLE_CLASS))
+ Perl_croak(aTHX_ "Usage: APR::Request::args($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+
+
+ if (items == 2 && GIMME_V == G_SCALAR) {
+ apreq_param_t *p = apreq_args_get(req, SvPV_nolen(ST(1)));
+
+ if (p != NULL) {
+ ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ else {
+ const apr_table_t *t;
+ apr_status_t s;
+ s = apreq_args(req, &t);
+
+ if (apreq_module_status_is_error(s))
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", ERROR_CLASS);
+
+ XSRETURN_UNDEF;
+ }
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_args(req, &t);
+
+ if (apreq_module_status_is_error(s))
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", ERROR_CLASS);
+
+ if (t == NULL)
+ XSRETURN_EMPTY;
+
+ d.pkg = NULL;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ XSprePUSH;
+ PUTBACK;
+ if (items == 1)
+ apr_table_do(apreq_xs_param_table_keys, &d, t, NULL);
+ else
+ apr_table_do(apreq_xs_param_table_values, &d, t,
+ SvPV_nolen(ST(1)), NULL);
+ return;
+
+ case G_SCALAR:
+ ST(0) = apreq_xs_param_table2sv(aTHX_ t,
+ PARAM_TABLE_CLASS,
+ obj, NULL, 0);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
+
+static XS(apreq_xs_body)
+{
+ dXSARGS;
+ apreq_handle_t *req;
+ SV *sv, *obj;
+ IV iv;
+
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0),HANDLE_CLASS))
+ Perl_croak(aTHX_ "Usage: APR::Request::body($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+
+
+ if (items == 2 && GIMME_V == G_SCALAR) {
+ apreq_param_t *p = apreq_body_get(req, SvPV_nolen(ST(1)));
+
+ if (p != NULL) {
+ ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ else {
+ const apr_table_t *t;
+ apr_status_t s;
+ s = apreq_body(req, &t);
+
+ if (apreq_module_status_is_error(s))
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", ERROR_CLASS);
+
+ XSRETURN_UNDEF;
+ }
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+ apr_status_t s;
+
+ s = apreq_body(req, &t);
+
+ if (apreq_module_status_is_error(s))
+ APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", ERROR_CLASS);
+
+ if (t == NULL)
+ XSRETURN_EMPTY;
+
+ d.pkg = NULL;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ XSprePUSH;
+ PUTBACK;
+ if (items == 1)
+ apr_table_do(apreq_xs_param_table_keys, &d, t, NULL);
+ else
+ apr_table_do(apreq_xs_param_table_values, &d, t,
+ SvPV_nolen(ST(1)), NULL);
+ return;
+
+ case G_SCALAR:
+ ST(0) = apreq_xs_param_table2sv(aTHX_ t,
+ PARAM_TABLE_CLASS,
+ obj, NULL, 0);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
+
+
+static XS(apreq_xs_param)
+{
+ dXSARGS;
+ apreq_handle_t *req;
+ SV *sv, *obj;
+ IV iv;
+
+ if (items == 0 || items > 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), "APR::Request"))
+ Perl_croak(aTHX_ "Usage: APR::Request::param($req [,$name])");
+
+ sv = ST(0);
+ obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
+ iv = SvIVX(obj);
+ req = INT2PTR(apreq_handle_t *, iv);
+
+ if (items == 2 && GIMME_V == G_SCALAR) {
+ apreq_param_t *p = apreq_param(req, SvPV_nolen(ST(1)));
+
+ if (p != NULL) {
+ ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+ }
+ else {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ const apr_table_t *t;
+
+ d.pkg = NULL;
+ d.parent = obj;
+
+ switch (GIMME_V) {
+
+ case G_ARRAY:
+ XSprePUSH;
+ PUTBACK;
+ if (items == 1) {
+ apreq_args(req, &t);
+ if (t != NULL)
+ apr_table_do(apreq_xs_param_table_keys, &d, t, NULL);
+ apreq_body(req, &t);
+ if (t != NULL)
+ apr_table_do(apreq_xs_param_table_keys, &d, t, NULL);
+
+ }
+ else {
+ char *val = SvPV_nolen(ST(1));
+ apreq_args(req, &t);
+ if (t != NULL)
+ apr_table_do(apreq_xs_param_table_values, &d, t, val, NULL);
+ apreq_body(req, &t);
+ if (t != NULL)
+ apr_table_do(apreq_xs_param_table_values, &d, t, val, NULL);
+ }
+ return;
+
+ case G_SCALAR:
+ t = apreq_params(req, req->pool);
+ if (t == NULL)
+ XSRETURN_UNDEF;
+
+ ST(0) = apreq_xs_param_table2sv(aTHX_ t,
+ PARAM_TABLE_CLASS,
+ obj, NULL, 0);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+
+ default:
+ XSRETURN(0);
+ }
+ }
+}
static XS(apreq_xs_parse)
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Apache2/Apache2.pod
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Apache2/Apache2.pod?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Apache2/Apache2.pod (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Apache2/Apache2.pod Tue Apr 26 \
21:34:18 2005 @@ -2,18 +2,46 @@
APR::Request::Apache2
+
+
+
=head1 SYNOPSIS
use APR::Request::Apache2;
- my $req = APR::Request::Apache2->new($r);
+ my $req = APR::Request::Apache2->handle($r);
+
+
- my $body = $req->param("foo");
=head1 DESCRIPTION
+The C<< APR::Request::Apache2 >> module provides a constructor
+for interfacing with the mod_apreq2.so Apache module.
+
+
+
+
=head1 APR::Request::Apache2
+This package is derived from C<< APR::Request >>.
+
+
+=head2 handle
+
+ APR::Request::Apache2->handle($r)
+
+Creates an C<< APR::Request::Apache2 >> object. The argument C<< $r >>
+is the C<< Apache2::RequestRec >> object from mod_perl2.
+
+
+
+
=head1 SEE ALSO
+
+L<< APR::Request >>, L<< Apache2::RequestRec >>.
+
+
+
=head1 COPYRIGHT
Added: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/CGI/CGI.pod
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/CGI/CGI.pod?rev=164945&view=auto
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/CGI/CGI.pod (added)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/CGI/CGI.pod Tue Apr 26 21:34:18 \
2005 @@ -0,0 +1,61 @@
+=head1 NAME
+
+ APR::Request::CGI
+
+
+
+
+=head1 SYNOPSIS
+
+ use APR::Request::CGI;
+ my $req = APR::Request::CGI->new($pool);
+
+
+
+
+=head1 DESCRIPTION
+
+The C<< APR::Request::CGI >> module provides a constructor
+for accessing CGI request data associated to a pool via libapreq2.
+
+
+
+
+=head1 APR::Request::CGI
+
+This package is derived from C<< APR::Request >>.
+
+
+=head2 new
+
+ APR::Request::CGI->new($pool)
+
+Creates an C<< APR::Request::CGI >> object. The argument C<< $pool >>
+is an C<< APR::Pool >> object.
+
+
+
+
+=head1 SEE ALSO
+
+L<< APR::Request >>, L<< APR::Pool >>.
+
+
+
+
+=head1 COPYRIGHT
+
+ Copyright 2003-2005 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h \
(original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/APR__Request__Cookie.h \
Tue Apr 26 21:34:18 2005 @@ -1,69 +1,182 @@
-#include "apreq_xs_tables.h"
-
-#if (PERL_VERSION >= 8) /* MAGIC ITERATOR REQUIRES 5.8 */
-
-/* Requires perl 5.8 or better.
- * A custom MGVTBL with its "copy" slot filled allows
- * us to FETCH a table entry immediately during iteration.
- * For multivalued keys this is essential in order to get
- * the value corresponding to the current key, otherwise
- * values() will always report the first value repeatedly.
- * With this MGVTBL the keys() list always matches up with
- * the values() list, even in the multivalued case.
- * We only prefetch the value during iteration, because the
- * prefetch adds overhead to EXISTS and STORE operations.
- * They are only "penalized" when the perl program is iterating
- * via each(), which seems to be a reasonable tradeoff.
- */
-
-static int apreq_xs_table_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
- const char *name, int namelen)
-{
- /* Prefetch the value whenever the table iterator is > 0 */
- MAGIC *tie_magic = mg_find(nsv, PERL_MAGIC_tiedelem);
- SV *obj = SvRV(tie_magic->mg_obj);
- IV idx = SvIVX(obj);
- const apr_table_t *t = INT2PTR(apr_table_t *, idx);
- const apr_array_header_t *arr = apr_table_elts(t);
-
- idx = SvCUR(obj);
-
- if (idx > 0 && idx <= arr->nelts) {
- const apr_table_entry_t *te = (const apr_table_entry_t *)arr->elts;
- apreq_cookie_t *c = apreq_value_to_cookie(te[idx-1].val);
- MAGIC *my_magic = mg_find(obj, PERL_MAGIC_ext);
-
- SvMAGICAL_off(nsv);
- sv_setsv(nsv, sv_2mortal(apreq_xs_cookie2sv(aTHX_ c, my_magic->mg_ptr,
- my_magic->mg_obj)));
- }
-
- return 0;
+static int apreq_xs_cookie_table_values(void *data, const char *key,
+ const char *val)
+{
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+ dSP;
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ SV *sv = apreq_xs_cookie2sv(aTHX_ c, d->pkg, d->parent);
+
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
}
-static const MGVTBL apreq_xs_table_magic = {0, 0, 0, 0, 0,
- apreq_xs_table_magic_copy};
+static int apreq_xs_cookie_table_do_sub(void *data, const char *key,
+ const char *val)
+{
+ struct apreq_xs_do_arg *d = data;
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ dTHXa(d->perl);
+ dSP;
+ SV *sv = apreq_xs_cookie2sv(aTHX_ c, d->pkg, d->parent);
+ int rv;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ EXTEND(SP,2);
+
+ PUSHs(sv_2mortal(newSVpvn(c->v.name, c->v.nlen)));
+ PUSHs(sv_2mortal(sv));
+
+ PUTBACK;
+ rv = call_sv(d->sub, G_SCALAR);
+ SPAGAIN;
+ rv = (1 == rv) ? POPi : 1;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
-#endif
+ return rv;
+}
-static APR_INLINE
-SV *apreq_xs_table2sv(pTHX_ const apr_table_t *t, const char *class, SV *parent,
- const char *value_class, I32 vclen)
+static XS(apreq_xs_cookie_table_do)
{
- SV *sv = (SV *)newHV();
- SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
- sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, value_class, vclen);
+ dXSARGS;
+ struct apreq_xs_do_arg d = { NULL, NULL, NULL, aTHX };
+ const apr_table_t *t;
+ int i, rv = 1;
+ SV *sv, *t_obj;
+ IV iv;
+ MAGIC *mg;
+
+ if (items < 2 || !SvROK(ST(0)) || !SvROK(ST(1)))
+ Perl_croak(aTHX_ "Usage: $object->do(\\&callback, @keys)");
+ sv = ST(0);
+
+ t_obj = apreq_xs_sv2object(aTHX_ sv, COOKIE_TABLE_CLASS, 't');
+ iv = SvIVX(t_obj);
+ t = INT2PTR(const apr_table_t *, iv);
+ mg = mg_find(t_obj, PERL_MAGIC_ext);
+ d.parent = mg->mg_obj;
+ d.pkg = mg->mg_ptr;
+ d.sub = ST(1);
+
+ if (items == 2) {
+ rv = apr_table_do(apreq_xs_cookie_table_do_sub, &d, t, NULL);
+ XSRETURN_IV(rv);
+ }
-#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
+ for (i = 2; i < items; ++i) {
+ const char *key = SvPV_nolen(ST(i));
+ rv = apr_table_do(apreq_xs_cookie_table_do_sub, &d, t, key, NULL);
+ if (rv == 0)
+ break;
+ }
+ XSRETURN_IV(rv);
+}
- sv_magic(sv, NULL, PERL_MAGIC_ext, Nullch, -1);
- SvMAGIC(sv)->mg_virtual = (MGVTBL *)&apreq_xs_table_magic;
- SvMAGIC(sv)->mg_flags |= MGf_COPY;
+static XS(apreq_xs_cookie_table_FETCH)
+{
+ dXSARGS;
+ const apr_table_t *t;
+ const char *cookie_class;
+ SV *sv, *obj, *parent;
+ IV iv;
+ MAGIC *mg;
+
+ if (items != 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), COOKIE_TABLE_CLASS))
+ Perl_croak(aTHX_ "Usage: " COOKIE_TABLE_CLASS "::FETCH($table, $key)");
+
+ sv = ST(0);
+
+ obj = apreq_xs_sv2object(aTHX_ sv, COOKIE_TABLE_CLASS, 't');
+ iv = SvIVX(obj);
+ t = INT2PTR(const apr_table_t *, iv);
+
+ mg = mg_find(obj, PERL_MAGIC_ext);
+ cookie_class = mg->mg_ptr;
+ parent = mg->mg_obj;
+
+ if (GIMME_V == G_SCALAR) {
+ IV idx;
+ const char *key, *val;
+ const apr_array_header_t *arr;
+ apr_table_entry_t *te;
+ key = SvPV_nolen(ST(1));
+
+ idx = SvCUR(obj);
+ arr = apr_table_elts(t);
+ te = (apr_table_entry_t *)arr->elts;
+
+ if (idx > 0 && idx <= arr->nelts
+ && !strcasecmp(key, te[idx-1].key))
+ val = te[idx-1].val;
+ else
+ val = apr_table_get(t, key);
+
+ if (val != NULL) {
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ ST(0) = apreq_xs_cookie2sv(aTHX_ c, cookie_class, parent);
+ sv_2mortal(ST(0));
+ XSRETURN(1);
+ }
+ else {
+ XSRETURN_UNDEF;
+ }
+ }
+ else if (GIMME_V == G_ARRAY) {
+ struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
+ d.pkg = cookie_class;
+ d.parent = parent;
+ XSprePUSH;
+ PUTBACK;
+ apr_table_do(apreq_xs_cookie_table_values, &d, t, SvPV_nolen(ST(1)), NULL);
+ }
+ else
+ XSRETURN(0);
+}
-#endif
+static XS(apreq_xs_cookie_table_NEXTKEY)
+{
+ dXSARGS;
+ SV *sv, *obj;
+ IV iv, idx;
+ const apr_table_t *t;
+ const apr_array_header_t *arr;
+ apr_table_entry_t *te;
+
+ if (!SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: $table->NEXTKEY($prev)");
+
+ sv = ST(0);
+ obj = apreq_xs_sv2object(aTHX_ sv, COOKIE_TABLE_CLASS, 't');
+
+ iv = SvIVX(obj);
+ t = INT2PTR(const apr_table_t *, iv);
+ arr = apr_table_elts(t);
+ te = (apr_table_entry_t *)arr->elts;
+
+ if (items == 1)
+ SvCUR(obj) = 0;
+
+ if (SvCUR(obj) >= arr->nelts) {
+ SvCUR(obj) = 0;
+ XSRETURN_UNDEF;
+ }
+ idx = SvCUR(obj)++;
+ sv = newSVpv(te[idx].key, 0);
+ ST(0) = sv_2mortal(sv);
+ XSRETURN(1);
+}
- sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
- SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
- return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
+static XS(XS_APR__Request__Cookie_nil)
+{
+ dXSARGS;
+ (void)items;
+ XSRETURN_EMPTY;
}
Added: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pod
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pod?rev=164945&view=auto
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pod (added)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.pod Tue Apr 26 \
21:34:18 2005 @@ -0,0 +1,31 @@
+=head1 NAME
+
+ APR::Request::CGI
+
+=head1 SYNOPSIS
+
+ use APR::Request::CGI;
+ my $req = APR::Request::CGI->new($pool);
+
+
+=head1 DESCRIPTION
+
+=head1 APR::Request::CGI
+
+=head1 SEE ALSO
+
+=head1 COPYRIGHT
+
+ Copyright 2003-2005 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Cookie/Cookie.xs Tue Apr 26 \
21:34:18 2005 @@ -1,215 +1,3 @@
-#define TABLE_CLASS "APR::Request::Cookie::Table"
-
-static int apreq_xs_table_keys(void *data, const char *key, const char *val)
-{
-#ifdef USE_ITHREADS
- struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
- dTHXa(d->perl);
-#endif
- dSP;
- apreq_cookie_t *c = apreq_value_to_cookie(val);
- SV *sv = newSVpvn(key, c->v.nlen);
- if (apreq_cookie_is_tainted(c))
- SvTAINTED_on(sv);
-
-#ifndef USE_ITHREADS
- (void)data;
-#endif
- XPUSHs(sv_2mortal(sv));
- PUTBACK;
- return 1;
-}
-
-static int apreq_xs_table_values(void *data, const char *key, const char *val)
-{
- struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
- dTHXa(d->perl);
- dSP;
- apreq_cookie_t *c = apreq_value_to_cookie(val);
- SV *sv = apreq_xs_cookie2sv(aTHX_ c, d->pkg, d->parent);
-
- XPUSHs(sv_2mortal(sv));
- PUTBACK;
- return 1;
-}
-
-static XS(apreq_xs_jar)
-{
- dXSARGS;
- apreq_handle_t *req;
- SV *sv, *obj;
- IV iv;
-
- if (items == 0 || items > 2 || !SvROK(ST(0))
- || !sv_derived_from(ST(0), "APR::Request"))
- Perl_croak(aTHX_ "Usage: APR::Request::jar($req [,$name])");
-
- sv = ST(0);
- obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
- iv = SvIVX(obj);
- req = INT2PTR(apreq_handle_t *, iv);
-
- if (items == 2 && GIMME_V == G_SCALAR) {
- apreq_cookie_t *c = apreq_jar_get(req, SvPV_nolen(ST(1)));
- if (c != NULL) {
- ST(0) = apreq_xs_cookie2sv(aTHX_ c, NULL, obj);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else {
- const apr_table_t *t;
- apr_status_t s;
-
- s = apreq_jar(req, &t);
- if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", ERROR_CLASS);
-
- XSRETURN_UNDEF;
- }
- }
- else {
- struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
- const apr_table_t *t;
- apr_status_t s;
-
- s = apreq_jar(req, &t);
-
- if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::jar", ERROR_CLASS);
-
- if (t == NULL)
- XSRETURN_EMPTY;
-
- d.pkg = NULL;
- d.parent = obj;
-
- switch (GIMME_V) {
-
- case G_ARRAY:
- XSprePUSH;
- PUTBACK;
- if (items == 1)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
- else
- apr_table_do(apreq_xs_table_values, &d, t,
- SvPV_nolen(ST(1)), NULL);
- return;
-
- case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj, NULL, 0);
- sv_2mortal(ST(0));
- XSRETURN(1);
-
- default:
- XSRETURN(0);
- }
- }
-}
-
-static XS(apreq_xs_table_FETCH)
-{
- dXSARGS;
- const apr_table_t *t;
- const char *cookie_class;
- SV *sv, *obj, *parent;
- IV iv;
- MAGIC *mg;
-
- if (items != 2 || !SvROK(ST(0))
- || !sv_derived_from(ST(0), TABLE_CLASS))
- Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::FETCH($table, $key)");
-
- sv = ST(0);
-
- obj = apreq_xs_sv2object(aTHX_ sv, TABLE_CLASS, 't');
- iv = SvIVX(obj);
- t = INT2PTR(const apr_table_t *, iv);
-
- mg = mg_find(obj, PERL_MAGIC_ext);
- cookie_class = mg->mg_ptr;
- parent = mg->mg_obj;
-
- if (GIMME_V == G_SCALAR) {
- IV idx;
- const char *key, *val;
- const apr_array_header_t *arr;
- apr_table_entry_t *te;
- key = SvPV_nolen(ST(1));
-
- idx = SvCUR(obj);
- arr = apr_table_elts(t);
- te = (apr_table_entry_t *)arr->elts;
-
- if (idx > 0 && idx <= arr->nelts
- && !strcasecmp(key, te[idx-1].key))
- val = te[idx-1].val;
- else
- val = apr_table_get(t, key);
-
- if (val != NULL) {
- apreq_cookie_t *c = apreq_value_to_cookie(val);
- ST(0) = apreq_xs_cookie2sv(aTHX_ c, cookie_class, parent);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else {
- XSRETURN_UNDEF;
- }
- }
- else if (GIMME_V == G_ARRAY) {
- struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
- d.pkg = cookie_class;
- d.parent = parent;
- XSprePUSH;
- PUTBACK;
- apr_table_do(apreq_xs_table_values, &d, t, SvPV_nolen(ST(1)), NULL);
- }
- else
- XSRETURN(0);
-}
-
-static XS(apreq_xs_table_NEXTKEY)
-{
- dXSARGS;
- SV *sv, *obj;
- IV iv, idx;
- const apr_table_t *t;
- const apr_array_header_t *arr;
- apr_table_entry_t *te;
-
- if (!SvROK(ST(0)))
- Perl_croak(aTHX_ "Usage: $table->NEXTKEY($prev)");
-
- sv = ST(0);
- obj = apreq_xs_sv2object(aTHX_ sv, TABLE_CLASS, 't');
-
- iv = SvIVX(obj);
- t = INT2PTR(const apr_table_t *, iv);
- arr = apr_table_elts(t);
- te = (apr_table_entry_t *)arr->elts;
-
- if (items == 1)
- SvCUR(obj) = 0;
-
- if (SvCUR(obj) >= arr->nelts) {
- SvCUR(obj) = 0;
- XSRETURN_UNDEF;
- }
- idx = SvCUR(obj)++;
- sv = newSVpv(te[idx].key, 0);
- ST(0) = sv_2mortal(sv);
- XSRETURN(1);
-}
-
-
-static XS(XS_APR__Request__Cookie_nil)
-{
- dXSARGS;
- (void)items;
- XSRETURN_EMPTY;
-}
-
-
MODULE = APR::Request::Cookie PACKAGE = APR::Request::Cookie
SV *
@@ -252,6 +40,7 @@
);
newXS("APR::Request::Cookie::()", XS_APR__Request__Cookie_nil, file);
newXS("APR::Request::Cookie::(\"\"", XS_APR__Request__Cookie_value, file);
+ newXS("APR::Request::Cookie::Table::do", apreq_xs_cookie_table_do, file);
MODULE = APR::Request::Cookie PACKAGE = APR::Request::Cookie
@@ -381,7 +170,7 @@
char *newclass
PREINIT:
- SV *obj = apreq_xs_sv2object(aTHX_ ST(0), TABLE_CLASS, 't');
+ SV *obj = apreq_xs_sv2object(aTHX_ ST(0), COOKIE_TABLE_CLASS, 't');
MAGIC *mg = mg_find(obj, PERL_MAGIC_ext);
char *curclass = mg->mg_ptr;
@@ -390,7 +179,8 @@
if (newclass != NULL) {
if (!sv_derived_from(ST(1), COOKIE_CLASS))
- Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::cookie_class($table, $class): \
" + Perl_croak(aTHX_ "Usage: "
+ COOKIE_TABLE_CLASS "::cookie_class($table, $class): "
"class %s is not derived from " COOKIE_CLASS, \
newclass); mg->mg_ptr = savepv(newclass);
mg->mg_len = strlen(newclass);
Added: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Error/Error.pod
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Error/Error.pod?rev=164945&view=auto
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Error/Error.pod (added)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Error/Error.pod Tue Apr 26 \
21:34:18 2005 @@ -0,0 +1,31 @@
+=head1 NAME
+
+ APR::Request::CGI
+
+=head1 SYNOPSIS
+
+ use APR::Request::CGI;
+ my $req = APR::Request::CGI->new($pool);
+
+
+=head1 DESCRIPTION
+
+=head1 APR::Request::CGI
+
+=head1 SEE ALSO
+
+=head1 COPYRIGHT
+
+ Copyright 2003-2005 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h \
(original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/APR__Request__Param.h Tue \
Apr 26 21:34:18 2005 @@ -1,336 +1,188 @@
-#include "apreq_xs_tables.h"
-#define TABLE_CLASS "APR::Request::Param::Table"
-
-#if (PERL_VERSION >= 8) /* MAGIC ITERATOR REQUIRES 5.8 */
-
-/* Requires perl 5.8 or better.
- * A custom MGVTBL with its "copy" slot filled allows
- * us to FETCH a table entry immediately during iteration.
- * For multivalued keys this is essential in order to get
- * the value corresponding to the current key, otherwise
- * values() will always report the first value repeatedly.
- * With this MGVTBL the keys() list always matches up with
- * the values() list, even in the multivalued case.
- * We only prefetch the value during iteration, because the
- * prefetch adds overhead to EXISTS and STORE operations.
- * They are only "penalized" when the perl program is iterating
- * via each(), which seems to be a reasonable tradeoff.
- */
-
-static int apreq_xs_table_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
- const char *name, int namelen)
-{
- /* Prefetch the value whenever the table iterator is > 0 */
- MAGIC *tie_magic = mg_find(nsv, PERL_MAGIC_tiedelem);
- SV *obj = SvRV(tie_magic->mg_obj);
- IV idx = SvIVX(obj);
- const apr_table_t *t = INT2PTR(apr_table_t *, idx);
- const apr_array_header_t *arr = apr_table_elts(t);
-
- idx = SvCUR(obj);
-
- if (idx > 0 && idx <= arr->nelts) {
- const apr_table_entry_t *te = (const apr_table_entry_t *)arr->elts;
- apreq_param_t *p = apreq_value_to_param(te[idx-1].val);
- MAGIC *my_magic = mg_find(obj, PERL_MAGIC_ext);
-
- SvMAGICAL_off(nsv);
- sv_setsv(nsv, sv_2mortal(apreq_xs_param2sv(aTHX_ p, my_magic->mg_ptr,
- my_magic->mg_obj)));
- }
-
- return 0;
-}
-
-static const MGVTBL apreq_xs_table_magic = {0, 0, 0, 0, 0,
- apreq_xs_table_magic_copy};
-
-#endif
-
-static APR_INLINE
-SV *apreq_xs_table2sv(pTHX_ const apr_table_t *t, const char *class, SV *parent,
- const char *value_class, I32 vclen)
+static int apreq_xs_param_table_values(void *data, const char *key,
+ const char *val)
{
- SV *sv = (SV *)newHV();
- SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
- sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, value_class, vclen);
-
-#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
-
- sv_magic(sv, NULL, PERL_MAGIC_ext, Nullch, -1);
- SvMAGIC(sv)->mg_virtual = (MGVTBL *)&apreq_xs_table_magic;
- SvMAGIC(sv)->mg_flags |= MGf_COPY;
-
-#endif
-
- sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
- SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
-
- return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
-}
-
-static int apreq_xs_table_keys(void *data, const char *key, const char *val)
-{
-#ifdef USE_ITHREADS
struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
dTHXa(d->perl);
-#endif
dSP;
apreq_param_t *p = apreq_value_to_param(val);
- SV *sv = newSVpvn(key, p->v.nlen);
-
-#ifndef USE_ITHREADS
- (void)data;
-#endif
-
- if (apreq_param_is_tainted(p))
- SvTAINTED_on(sv);
+ SV *sv = apreq_xs_param2sv(aTHX_ p, d->pkg, d->parent);
XPUSHs(sv_2mortal(sv));
PUTBACK;
return 1;
}
-static int apreq_xs_table_values(void *data, const char *key, const char *val)
+
+static int apreq_xs_param_table_do_sub(void *data, const char *key,
+ const char *val)
{
- struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ struct apreq_xs_do_arg *d = data;
+ apreq_param_t *p = apreq_value_to_param(val);
dTHXa(d->perl);
dSP;
- apreq_param_t *p = apreq_value_to_param(val);
SV *sv = apreq_xs_param2sv(aTHX_ p, d->pkg, d->parent);
+ int rv;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ EXTEND(SP,2);
+
+ PUSHs(sv_2mortal(newSVpvn(p->v.name, p->v.nlen)));
+ PUSHs(sv_2mortal(sv));
- XPUSHs(sv_2mortal(sv));
PUTBACK;
- return 1;
-}
+ rv = call_sv(d->sub, G_SCALAR);
+ SPAGAIN;
+ rv = (1 == rv) ? POPi : 1;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ return rv;
+}
-static XS(apreq_xs_args)
+static XS(apreq_xs_param_table_do)
{
dXSARGS;
- apreq_handle_t *req;
- SV *sv, *obj;
+ struct apreq_xs_do_arg d = { NULL, NULL, NULL, aTHX };
+ const apr_table_t *t;
+ int i, rv = 1;
+ SV *sv, *t_obj;
IV iv;
+ MAGIC *mg;
- if (items == 0 || items > 2 || !SvROK(ST(0))
- || !sv_derived_from(ST(0), HANDLE_CLASS))
- Perl_croak(aTHX_ "Usage: APR::Request::args($req [,$name])");
-
+ if (items < 2 || !SvROK(ST(0)) || !SvROK(ST(1)))
+ Perl_croak(aTHX_ "Usage: $object->do(\\&callback, @keys)");
sv = ST(0);
- obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
- iv = SvIVX(obj);
- req = INT2PTR(apreq_handle_t *, iv);
-
- if (items == 2 && GIMME_V == G_SCALAR) {
- apreq_param_t *p = apreq_args_get(req, SvPV_nolen(ST(1)));
+ t_obj = apreq_xs_sv2object(aTHX_ sv, PARAM_TABLE_CLASS, 't');
+ iv = SvIVX(t_obj);
+ t = INT2PTR(const apr_table_t *, iv);
+ mg = mg_find(t_obj, PERL_MAGIC_ext);
+ d.parent = mg->mg_obj;
+ d.pkg = mg->mg_ptr;
+ d.sub = ST(1);
- if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else {
- const apr_table_t *t;
- apr_status_t s;
- s = apreq_args(req, &t);
-
- if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", ERROR_CLASS);
-
- XSRETURN_UNDEF;
- }
+ if (items == 2) {
+ rv = apr_table_do(apreq_xs_param_table_do_sub, &d, t, NULL);
+ XSRETURN_IV(rv);
}
- else {
- struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
- const apr_table_t *t;
- apr_status_t s;
-
- s = apreq_args(req, &t);
-
- if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::args", ERROR_CLASS);
-
- if (t == NULL)
- XSRETURN_EMPTY;
-
- d.pkg = NULL;
- d.parent = obj;
-
- switch (GIMME_V) {
-
- case G_ARRAY:
- XSprePUSH;
- PUTBACK;
- if (items == 1)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
- else
- apr_table_do(apreq_xs_table_values, &d, t,
- SvPV_nolen(ST(1)), NULL);
- return;
-
- case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj, NULL, 0);
- sv_2mortal(ST(0));
- XSRETURN(1);
- default:
- XSRETURN(0);
- }
+ for (i = 2; i < items; ++i) {
+ const char *key = SvPV_nolen(ST(i));
+ rv = apr_table_do(apreq_xs_param_table_do_sub, &d, t, key, NULL);
+ if (rv == 0)
+ break;
}
+ XSRETURN_IV(rv);
}
-static XS(apreq_xs_body)
+static XS(apreq_xs_param_table_FETCH)
{
dXSARGS;
- apreq_handle_t *req;
- SV *sv, *obj;
+ const apr_table_t *t;
+ const char *param_class;
+ SV *sv, *t_obj, *parent;
IV iv;
+ MAGIC *mg;
- if (items == 0 || items > 2 || !SvROK(ST(0))
- || !sv_derived_from(ST(0),HANDLE_CLASS))
- Perl_croak(aTHX_ "Usage: APR::Request::body($req [,$name])");
+ if (items != 2 || !SvROK(ST(0))
+ || !sv_derived_from(ST(0), PARAM_TABLE_CLASS))
+ Perl_croak(aTHX_ "Usage: " PARAM_TABLE_CLASS "::FETCH($table, $key)");
sv = ST(0);
- obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
- iv = SvIVX(obj);
- req = INT2PTR(apreq_handle_t *, iv);
-
-
- if (items == 2 && GIMME_V == G_SCALAR) {
- apreq_param_t *p = apreq_body_get(req, SvPV_nolen(ST(1)));
- if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
+ t_obj = apreq_xs_sv2object(aTHX_ sv, PARAM_TABLE_CLASS, 't');
+ iv = SvIVX(t_obj);
+ t = INT2PTR(const apr_table_t *, iv);
+
+ mg = mg_find(t_obj, PERL_MAGIC_ext);
+ param_class = mg->mg_ptr;
+ parent = mg->mg_obj;
+
+
+ if (GIMME_V == G_SCALAR) {
+ IV idx;
+ const char *key, *val;
+ const apr_array_header_t *arr;
+ apr_table_entry_t *te;
+ key = SvPV_nolen(ST(1));
+
+ idx = SvCUR(t_obj);
+ arr = apr_table_elts(t);
+ te = (apr_table_entry_t *)arr->elts;
+
+ if (idx > 0 && idx <= arr->nelts
+ && !strcasecmp(key, te[idx-1].key))
+ val = te[idx-1].val;
+ else
+ val = apr_table_get(t, key);
+
+ if (val != NULL) {
+ apreq_param_t *p = apreq_value_to_param(val);
+ ST(0) = apreq_xs_param2sv(aTHX_ p, param_class, parent);
sv_2mortal(ST(0));
XSRETURN(1);
}
else {
- const apr_table_t *t;
- apr_status_t s;
- s = apreq_body(req, &t);
-
- if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", ERROR_CLASS);
-
XSRETURN_UNDEF;
}
}
- else {
+ else if (GIMME_V == G_ARRAY) {
struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
- const apr_table_t *t;
- apr_status_t s;
-
- s = apreq_body(req, &t);
-
- if (apreq_module_status_is_error(s))
- APREQ_XS_THROW_ERROR(r, s, "APR::Request::body", ERROR_CLASS);
-
- if (t == NULL)
- XSRETURN_EMPTY;
-
- d.pkg = NULL;
- d.parent = obj;
-
- switch (GIMME_V) {
-
- case G_ARRAY:
- XSprePUSH;
- PUTBACK;
- if (items == 1)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
- else
- apr_table_do(apreq_xs_table_values, &d, t,
- SvPV_nolen(ST(1)), NULL);
- return;
-
- case G_SCALAR:
- ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj, NULL, 0);
- sv_2mortal(ST(0));
- XSRETURN(1);
-
- default:
- XSRETURN(0);
- }
+ d.pkg = param_class;
+ d.parent = parent;
+ XSprePUSH;
+ PUTBACK;
+ apr_table_do(apreq_xs_param_table_values, &d, t, SvPV_nolen(ST(1)), NULL);
}
+ else
+ XSRETURN(0);
}
-
-static XS(apreq_xs_param)
+static XS(apreq_xs_param_table_NEXTKEY)
{
dXSARGS;
- apreq_handle_t *req;
SV *sv, *obj;
- IV iv;
+ IV iv, idx;
+ const apr_table_t *t;
+ const apr_array_header_t *arr;
+ apr_table_entry_t *te;
- if (items == 0 || items > 2 || !SvROK(ST(0))
- || !sv_derived_from(ST(0), "APR::Request"))
- Perl_croak(aTHX_ "Usage: APR::Request::param($req [,$name])");
+ if (!SvROK(ST(0)) || !sv_derived_from(ST(0), PARAM_TABLE_CLASS))
+ Perl_croak(aTHX_ "Usage: " PARAM_TABLE_CLASS "::NEXTKEY($table, $key)");
+
+ sv = ST(0);
+ obj = apreq_xs_sv2object(aTHX_ sv, PARAM_TABLE_CLASS,'t');
- sv = ST(0);
- obj = apreq_xs_sv2object(aTHX_ sv, HANDLE_CLASS, 'r');
iv = SvIVX(obj);
- req = INT2PTR(apreq_handle_t *, iv);
+ t = INT2PTR(const apr_table_t *, iv);
+ arr = apr_table_elts(t);
+ te = (apr_table_entry_t *)arr->elts;
- if (items == 2 && GIMME_V == G_SCALAR) {
- apreq_param_t *p = apreq_param(req, SvPV_nolen(ST(1)));
+ if (items == 1)
+ SvCUR(obj) = 0;
- if (p != NULL) {
- ST(0) = apreq_xs_param2sv(aTHX_ p, NULL, obj);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else {
- XSRETURN_UNDEF;
- }
+ if (SvCUR(obj) >= arr->nelts) {
+ SvCUR(obj) = 0;
+ XSRETURN_UNDEF;
}
- else {
- struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
- const apr_table_t *t;
-
- d.pkg = NULL;
- d.parent = obj;
-
- switch (GIMME_V) {
-
- case G_ARRAY:
- XSprePUSH;
- PUTBACK;
- if (items == 1) {
- apreq_args(req, &t);
- if (t != NULL)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
- apreq_body(req, &t);
- if (t != NULL)
- apr_table_do(apreq_xs_table_keys, &d, t, NULL);
-
- }
- else {
- char *val = SvPV_nolen(ST(1));
- apreq_args(req, &t);
- if (t != NULL)
- apr_table_do(apreq_xs_table_values, &d, t, val, NULL);
- apreq_body(req, &t);
- if (t != NULL)
- apr_table_do(apreq_xs_table_values, &d, t, val, NULL);
- }
- return;
-
- case G_SCALAR:
- t = apreq_params(req, req->pool);
- if (t == NULL)
- XSRETURN_UNDEF;
-
- ST(0) = apreq_xs_table2sv(aTHX_ t, TABLE_CLASS, obj,
- NULL, 0);
- sv_2mortal(ST(0));
- XSRETURN(1);
+ idx = SvCUR(obj)++;
+ sv = newSVpv(te[idx].key, 0);
+ ST(0) = sv_2mortal(sv);
+ XSRETURN(1);
+}
- default:
- XSRETURN(0);
- }
- }
+
+static XS(XS_APR__Request__Param_nil)
+{
+ dXSARGS;
+ (void)items;
+ XSRETURN_EMPTY;
}
+
APR_INLINE
static SV *apreq_xs_find_bb_obj(pTHX_ SV *in)
Added: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.pod
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.pod?rev=164945&view=auto
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.pod (added)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.pod Tue Apr 26 \
21:34:18 2005 @@ -0,0 +1,31 @@
+=head1 NAME
+
+ APR::Request::CGI
+
+=head1 SYNOPSIS
+
+ use APR::Request::CGI;
+ my $req = APR::Request::CGI->new($pool);
+
+
+=head1 DESCRIPTION
+
+=head1 APR::Request::CGI
+
+=head1 SEE ALSO
+
+=head1 COPYRIGHT
+
+ Copyright 2003-2005 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.xs
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.xs?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.xs (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Param/Param.xs Tue Apr 26 \
21:34:18 2005 @@ -1,180 +1,3 @@
-
-#ifdef AP_DEBUG
-/* Undo httpd.h's strchr override. */
-#undef strchr
-#endif
-
-static int apreq_xs_table_do_sub(void *data, const char *key,
- const char *val)
-{
- struct apreq_xs_do_arg *d = data;
- apreq_param_t *p = apreq_value_to_param(val);
- dTHXa(d->perl);
- dSP;
- SV *sv = apreq_xs_param2sv(aTHX_ p, d->pkg, d->parent);
- int rv;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- EXTEND(SP,2);
-
- PUSHs(sv_2mortal(newSVpvn(p->v.name, p->v.nlen)));
- PUSHs(sv_2mortal(sv));
-
- PUTBACK;
- rv = call_sv(d->sub, G_SCALAR);
- SPAGAIN;
- rv = (1 == rv) ? POPi : 1;
- PUTBACK;
- FREETMPS;
- LEAVE;
-
- return rv;
-}
-
-static XS(apreq_xs_table_do)
-{
- dXSARGS;
- struct apreq_xs_do_arg d = { NULL, NULL, NULL, aTHX };
- const apr_table_t *t;
- int i, rv = 1;
- SV *sv, *t_obj;
- IV iv;
- MAGIC *mg;
-
- if (items < 2 || !SvROK(ST(0)) || !SvROK(ST(1)))
- Perl_croak(aTHX_ "Usage: $object->do(\\&callback, @keys)");
- sv = ST(0);
-
- t_obj = apreq_xs_sv2object(aTHX_ sv, TABLE_CLASS, 't');
- iv = SvIVX(t_obj);
- t = INT2PTR(const apr_table_t *, iv);
- mg = mg_find(t_obj, PERL_MAGIC_ext);
- d.parent = mg->mg_obj;
- d.pkg = mg->mg_ptr;
- d.sub = ST(1);
-
- if (items == 2) {
- rv = apr_table_do(apreq_xs_table_do_sub, &d, t, NULL);
- XSRETURN_IV(rv);
- }
-
- for (i = 2; i < items; ++i) {
- const char *key = SvPV_nolen(ST(i));
- rv = apr_table_do(apreq_xs_table_do_sub, &d, t, key, NULL);
- if (rv == 0)
- break;
- }
- XSRETURN_IV(rv);
-}
-
-static XS(apreq_xs_table_FETCH)
-{
- dXSARGS;
- const apr_table_t *t;
- const char *param_class;
- SV *sv, *t_obj, *parent;
- IV iv;
- MAGIC *mg;
-
- if (items != 2 || !SvROK(ST(0))
- || !sv_derived_from(ST(0), TABLE_CLASS))
- Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::FETCH($table, $key)");
-
- sv = ST(0);
-
- t_obj = apreq_xs_sv2object(aTHX_ sv, TABLE_CLASS, 't');
- iv = SvIVX(t_obj);
- t = INT2PTR(const apr_table_t *, iv);
-
- mg = mg_find(t_obj, PERL_MAGIC_ext);
- param_class = mg->mg_ptr;
- parent = mg->mg_obj;
-
-
- if (GIMME_V == G_SCALAR) {
- IV idx;
- const char *key, *val;
- const apr_array_header_t *arr;
- apr_table_entry_t *te;
- key = SvPV_nolen(ST(1));
-
- idx = SvCUR(t_obj);
- arr = apr_table_elts(t);
- te = (apr_table_entry_t *)arr->elts;
-
- if (idx > 0 && idx <= arr->nelts
- && !strcasecmp(key, te[idx-1].key))
- val = te[idx-1].val;
- else
- val = apr_table_get(t, key);
-
- if (val != NULL) {
- apreq_param_t *p = apreq_value_to_param(val);
- ST(0) = apreq_xs_param2sv(aTHX_ p, param_class, parent);
- sv_2mortal(ST(0));
- XSRETURN(1);
- }
- else {
- XSRETURN_UNDEF;
- }
- }
- else if (GIMME_V == G_ARRAY) {
- struct apreq_xs_do_arg d = {NULL, NULL, NULL, aTHX};
- d.pkg = param_class;
- d.parent = parent;
- XSprePUSH;
- PUTBACK;
- apr_table_do(apreq_xs_table_values, &d, t, SvPV_nolen(ST(1)), NULL);
- }
- else
- XSRETURN(0);
-}
-
-static XS(apreq_xs_table_NEXTKEY)
-{
- dXSARGS;
- SV *sv, *obj;
- IV iv, idx;
- const apr_table_t *t;
- const apr_array_header_t *arr;
- apr_table_entry_t *te;
-
- if (!SvROK(ST(0)) || !sv_derived_from(ST(0), TABLE_CLASS))
- Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::NEXTKEY($table, $key)");
-
- sv = ST(0);
- obj = apreq_xs_sv2object(aTHX_ sv, TABLE_CLASS,'t');
-
- iv = SvIVX(obj);
- t = INT2PTR(const apr_table_t *, iv);
- arr = apr_table_elts(t);
- te = (apr_table_entry_t *)arr->elts;
-
- if (items == 1)
- SvCUR(obj) = 0;
-
- if (SvCUR(obj) >= arr->nelts) {
- SvCUR(obj) = 0;
- XSRETURN_UNDEF;
- }
- idx = SvCUR(obj)++;
- sv = newSVpv(te[idx].key, 0);
- ST(0) = sv_2mortal(sv);
- XSRETURN(1);
-}
-
-
-static XS(XS_APR__Request__Param_nil)
-{
- dXSARGS;
- (void)items;
- XSRETURN_EMPTY;
-}
-
-
MODULE = APR::Request::Param PACKAGE = APR::Request::Param
SV *
@@ -229,7 +52,7 @@
);
newXS("APR::Request::Param::()", XS_APR__Request__Param_nil, file);
newXS("APR::Request::Param::(\"\"", XS_APR__Request__Param_value, file);
- newXS("APR::Request::Param::Table::do", apreq_xs_table_do, file);
+ newXS("APR::Request::Param::Table::do", apreq_xs_param_table_do, file);
MODULE = APR::Request::Param PACKAGE = APR::Request::Param
@@ -313,7 +136,7 @@
char *newclass
PREINIT:
- SV *obj = apreq_xs_sv2object(aTHX_ ST(0), TABLE_CLASS, 't');
+ SV *obj = apreq_xs_sv2object(aTHX_ ST(0), PARAM_TABLE_CLASS, 't');
MAGIC *mg = mg_find(obj, PERL_MAGIC_ext);
char *curclass = mg->mg_ptr;
@@ -322,7 +145,8 @@
if (newclass != NULL) {
if (!sv_derived_from(ST(1), PARAM_CLASS))
- Perl_croak(aTHX_ "Usage: " TABLE_CLASS "::param_class($table, $class): "
+ Perl_croak(aTHX_ "Usage: "
+ PARAM_TABLE_CLASS "::param_class($table, $class): "
"class %s is not derived from " PARAM_CLASS, newclass);
mg->mg_ptr = savepv(newclass);
mg->mg_len = strlen(newclass);
@@ -492,21 +316,5 @@
OUTPUT:
RETVAL
-
-MODULE = APR::Request::Param PACKAGE = APR::Request::Param::Table
-
-SV *
-uploads(t, pool)
- APR::Request::Param::Table t
- APR::Pool pool
- PREINIT:
- SV *obj = apreq_xs_sv2object(aTHX_ ST(0), TABLE_CLASS, 't');
- SV *parent = apreq_xs_sv2object(aTHX_ ST(0), HANDLE_CLASS, 'r');
- MAGIC *mg = mg_find(obj, PERL_MAGIC_ext);
- CODE:
- RETVAL = apreq_xs_table2sv(aTHX_ apreq_uploads(t, pool), HvNAME(SvSTASH(obj)),
- parent, mg->mg_ptr, mg->mg_len);
- OUTPUT:
- RETVAL
Added: httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.pod
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.pod?rev=164945&view=auto
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.pod (added)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.pod Tue Apr 26 21:34:18 \
2005 @@ -0,0 +1,53 @@
+=head1 NAME
+
+ APR::Request
+
+
+
+
+=head1 SYNOPSIS
+
+ use APR::Request;
+ my $req = APR::Request->handle($pool, ...);
+
+
+
+
+=head1 DESCRIPTION
+
+The C<< APR::Request >> module provides the base methods
+for interfacing with libapreq2's module api. It also provides
+a few utility functions and constants.
+
+
+
+
+=head1 APR::Request
+
+
+
+
+
+
+
+=head1 SEE ALSO
+
+L<< APR::Request >>
+
+
+
+=head1 COPYRIGHT
+
+ Copyright 2003-2005 The Apache Software Foundation
+
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
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=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/APR/Request/Request.xs Tue Apr 26 21:34:18 \
2005 @@ -230,11 +230,32 @@
CODE:
RETVAL = req->pool;
+
APR::BucketAlloc
bucket_alloc(req)
APR::Request req
CODE:
RETVAL = req->bucket_alloc;
+
+MODULE = APR::Request::Param PACKAGE = APR::Request::Param::Table
+
+SV *
+uploads(t, pool)
+ APR::Request::Param::Table t
+ APR::Pool pool
+ PREINIT:
+ SV *obj = apreq_xs_sv2object(aTHX_ ST(0), PARAM_TABLE_CLASS, 't');
+ SV *parent = apreq_xs_sv2object(aTHX_ ST(0), HANDLE_CLASS, 'r');
+ MAGIC *mg = mg_find(obj, PERL_MAGIC_ext);
+ CODE:
+ RETVAL = apreq_xs_param_table2sv(aTHX_ apreq_uploads(t, pool),
+ HvNAME(SvSTASH(obj)),
+ parent, mg->mg_ptr, mg->mg_len);
+ OUTPUT:
+ RETVAL
+
+
+
BOOT:
{
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_postperl.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_postperl.h?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_postperl.h (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_postperl.h Tue Apr 26 21:34:18 \
2005 @@ -39,10 +39,20 @@
#define APR__Request__Param__Table const apr_table_t *
#define APR__BucketAlloc apr_bucket_alloc_t *
-#define HANDLE_CLASS "APR::Request"
-#define COOKIE_CLASS "APR::Request::Cookie"
-#define PARAM_CLASS "APR::Request::Param"
-#define ERROR_CLASS "APR::Request::Error"
+#define HANDLE_CLASS "APR::Request"
+#define COOKIE_CLASS "APR::Request::Cookie"
+#define PARAM_CLASS "APR::Request::Param"
+#define ERROR_CLASS "APR::Request::Error"
+#define COOKIE_TABLE_CLASS "APR::Request::Cookie::Table"
+#define PARAM_TABLE_CLASS "APR::Request::Param::Table"
+
+struct apreq_xs_do_arg {
+ const char *pkg;
+ SV *parent,
+ *sub;
+ PerlInterpreter *perl;
+};
+
/**
* @file apreq_xs_postperl.h
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_preperl.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_preperl.h?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_preperl.h (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_preperl.h Tue Apr 26 21:34:18 2005
@@ -29,6 +29,11 @@
# endif
#endif
+/* Undo httpd.h's strchr override. */
+#ifdef AP_DEBUG
+# undef strchr
+#endif
+
/**
* @file apreq_xs_preperl.h
* @brief XS include file for making Cookie.so and Request.so, for things
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_tables.h
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_tables.h?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_tables.h (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/apreq_xs_tables.h Tue Apr 26 21:34:18 2005
@@ -21,11 +21,225 @@
#include "ppport.h"
-struct apreq_xs_do_arg {
- const char *pkg;
- SV *parent,
- *sub;
- PerlInterpreter *perl;
-};
+/**************************************************/
+
+
+#if (PERL_VERSION >= 8) /* MAGIC ITERATOR REQUIRES 5.8 */
+
+/* Requires perl 5.8 or better.
+ * A custom MGVTBL with its "copy" slot filled allows
+ * us to FETCH a table entry immediately during iteration.
+ * For multivalued keys this is essential in order to get
+ * the value corresponding to the current key, otherwise
+ * values() will always report the first value repeatedly.
+ * With this MGVTBL the keys() list always matches up with
+ * the values() list, even in the multivalued case.
+ * We only prefetch the value during iteration, because the
+ * prefetch adds overhead to EXISTS and STORE operations.
+ * They are only "penalized" when the perl program is iterating
+ * via each(), which seems to be a reasonable tradeoff.
+ */
+
+static int apreq_xs_cookie_table_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
+ const char *name, int namelen)
+{
+ /* Prefetch the value whenever the table iterator is > 0 */
+ MAGIC *tie_magic = mg_find(nsv, PERL_MAGIC_tiedelem);
+ SV *obj = SvRV(tie_magic->mg_obj);
+ IV idx = SvIVX(obj);
+ const apr_table_t *t = INT2PTR(apr_table_t *, idx);
+ const apr_array_header_t *arr = apr_table_elts(t);
+
+ idx = SvCUR(obj);
+
+ if (idx > 0 && idx <= arr->nelts) {
+ const apr_table_entry_t *te = (const apr_table_entry_t *)arr->elts;
+ apreq_cookie_t *c = apreq_value_to_cookie(te[idx-1].val);
+ MAGIC *my_magic = mg_find(obj, PERL_MAGIC_ext);
+
+ SvMAGICAL_off(nsv);
+ sv_setsv(nsv, sv_2mortal(apreq_xs_cookie2sv(aTHX_ c, my_magic->mg_ptr,
+ my_magic->mg_obj)));
+ }
+
+ return 0;
+}
+
+static const MGVTBL apreq_xs_cookie_table_magic = {0, 0, 0, 0, 0,
+ apreq_xs_cookie_table_magic_copy};
+
+#endif
+
+static APR_INLINE
+SV *apreq_xs_cookie_table2sv(pTHX_ const apr_table_t *t, const char *class, SV \
*parent, + const char *value_class, I32 vclen)
+{
+ SV *sv = (SV *)newHV();
+ SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
+ sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, value_class, vclen);
+
+#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
+
+ sv_magic(sv, NULL, PERL_MAGIC_ext, Nullch, -1);
+ SvMAGIC(sv)->mg_virtual = (MGVTBL *)&apreq_xs_cookie_table_magic;
+ SvMAGIC(sv)->mg_flags |= MGf_COPY;
+
+#endif
+
+ sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
+ SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
+
+ return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
+}
+
+
+
+static int apreq_xs_cookie_table_keys(void *data, const char *key,
+ const char *val)
+{
+#ifdef USE_ITHREADS
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+#endif
+ dSP;
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ SV *sv = newSVpvn(key, c->v.nlen);
+ if (apreq_cookie_is_tainted(c))
+ SvTAINTED_on(sv);
+
+#ifndef USE_ITHREADS
+ (void)data;
+#endif
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
+}
+
+static int apreq_xs_cookie_table_values(void *data, const char *key,
+ const char *val)
+{
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+ dSP;
+ apreq_cookie_t *c = apreq_value_to_cookie(val);
+ SV *sv = apreq_xs_cookie2sv(aTHX_ c, d->pkg, d->parent);
+
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
+}
+
+
+/**************************************************/
+
+
+#if (PERL_VERSION >= 8) /* MAGIC ITERATOR REQUIRES 5.8 */
+
+/* Requires perl 5.8 or better.
+ * A custom MGVTBL with its "copy" slot filled allows
+ * us to FETCH a table entry immediately during iteration.
+ * For multivalued keys this is essential in order to get
+ * the value corresponding to the current key, otherwise
+ * values() will always report the first value repeatedly.
+ * With this MGVTBL the keys() list always matches up with
+ * the values() list, even in the multivalued case.
+ * We only prefetch the value during iteration, because the
+ * prefetch adds overhead to EXISTS and STORE operations.
+ * They are only "penalized" when the perl program is iterating
+ * via each(), which seems to be a reasonable tradeoff.
+ */
+
+static int apreq_xs_param_table_magic_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
+ const char *name, int namelen)
+{
+ /* Prefetch the value whenever the table iterator is > 0 */
+ MAGIC *tie_magic = mg_find(nsv, PERL_MAGIC_tiedelem);
+ SV *obj = SvRV(tie_magic->mg_obj);
+ IV idx = SvIVX(obj);
+ const apr_table_t *t = INT2PTR(apr_table_t *, idx);
+ const apr_array_header_t *arr = apr_table_elts(t);
+
+ idx = SvCUR(obj);
+
+ if (idx > 0 && idx <= arr->nelts) {
+ const apr_table_entry_t *te = (const apr_table_entry_t *)arr->elts;
+ apreq_param_t *p = apreq_value_to_param(te[idx-1].val);
+ MAGIC *my_magic = mg_find(obj, PERL_MAGIC_ext);
+
+ SvMAGICAL_off(nsv);
+ sv_setsv(nsv, sv_2mortal(apreq_xs_param2sv(aTHX_ p, my_magic->mg_ptr,
+ my_magic->mg_obj)));
+ }
+
+ return 0;
+}
+
+static const MGVTBL apreq_xs_param_table_magic = {0, 0, 0, 0, 0,
+ apreq_xs_param_table_magic_copy};
+
+#endif
+
+static APR_INLINE
+SV *apreq_xs_param_table2sv(pTHX_ const apr_table_t *t, const char *class, SV \
*parent, + const char *value_class, I32 vclen)
+{
+ SV *sv = (SV *)newHV();
+ SV *rv = sv_setref_pv(newSV(0), class, (void *)t);
+ sv_magic(SvRV(rv), parent, PERL_MAGIC_ext, value_class, vclen);
+
+#if (PERL_VERSION >= 8) /* MAGIC ITERATOR requires 5.8 */
+
+ sv_magic(sv, NULL, PERL_MAGIC_ext, Nullch, -1);
+ SvMAGIC(sv)->mg_virtual = (MGVTBL *)&apreq_xs_param_table_magic;
+ SvMAGIC(sv)->mg_flags |= MGf_COPY;
+
+#endif
+
+ sv_magic(sv, rv, PERL_MAGIC_tied, Nullch, 0);
+ SvREFCNT_dec(rv); /* corrects SvREFCNT_inc(rv) implicit in sv_magic */
+
+ return sv_bless(newRV_noinc(sv), SvSTASH(SvRV(rv)));
+}
+
+
+
+static int apreq_xs_param_table_keys(void *data, const char *key,
+ const char *val)
+{
+#ifdef USE_ITHREADS
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+#endif
+ dSP;
+ apreq_param_t *p = apreq_value_to_param(val);
+ SV *sv = newSVpvn(key, p->v.nlen);
+
+#ifndef USE_ITHREADS
+ (void)data;
+#endif
+
+ if (apreq_param_is_tainted(p))
+ SvTAINTED_on(sv);
+
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
+}
+
+static int apreq_xs_param_table_values(void *data, const char *key,
+ const char *val)
+{
+ struct apreq_xs_do_arg *d = (struct apreq_xs_do_arg *)data;
+ dTHXa(d->perl);
+ dSP;
+ apreq_param_t *p = apreq_value_to_param(val);
+ SV *sv = apreq_xs_param2sv(aTHX_ p, d->pkg, d->parent);
+
+ XPUSHs(sv_2mortal(sv));
+ PUTBACK;
+ return 1;
+}
+
+
#endif /* APREQ_XS_TABLES_H */
Modified: httpd/apreq/trunk/glue/perl/xsbuilder/maps/apreq_functions.map
URL: http://svn.apache.org/viewcvs/httpd/apreq/trunk/glue/perl/xsbuilder/maps/apreq_functions.map?rev=164945&r1=164944&r2=164945&view=diff
==============================================================================
--- httpd/apreq/trunk/glue/perl/xsbuilder/maps/apreq_functions.map (original)
+++ httpd/apreq/trunk/glue/perl/xsbuilder/maps/apreq_functions.map Tue Apr 26 \
21:34:18 2005 @@ -1,108 +1,4 @@
########## Apache::Request:: Functions ##########
-
-#MODULE=Apache::Request PACKAGE=Apache::Request PREFIX=apreq_
-# apreq_request | apreq_xs_request | const char *:class, void *:env, const char \
*:qs=NULL
-# apreq_param | apreq_xs_request_get |
-
-#MODULE=Apache::Request PACKAGE=Apache::Request
-# DEFINE_env | apreq_xs_request_env |
-# DEFINE_args | apreq_xs_request_args_get |
-# DEFINE_body | apreq_xs_request_body_get |
-# DEFINE_config | apreq_xs_request_config |
-# DEFINE_parse | apreq_xs_request_parse |
-
-#MODULE=Apache::Request PACKAGE=Apache::Request::Table \
PREFIX=Apache__Request__Table_
-# DEFINE_get | apreq_xs_table_get |
-# DEFINE_FETCH | apreq_xs_table_FETCH |
-# DEFINE_set | apreq_xs_table_param_set |
-# DEFINE_STORE | apreq_xs_table_param_set |
-# DEFINE_add | apreq_xs_table_param_add |
-# DEFINE_new | apreq_xs_table_request_make |
-# DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
-# DEFINE_FIRSTKEY | apreq_xs_table_NEXTKEY |
-# DEFINE_do | apreq_xs_table_do |
-
-########## Apache::Upload:: Functions ##########
-
-#MODULE=Apache::Upload PACKAGE=Apache::Upload PREFIX=Apache__Upload_
-# const char *:DEFINE_name | apreq_param_name(apreq_xs_sv2param(sv)) | SV \
*:sv
-# char *:DEFINE_filename | apreq_param_value(apreq_xs_sv2param(sv)) | SV \
*:sv
-# DEFINE_env | apreq_xs_upload_env |
-# DEFINE_link | apreq_xs_upload_link |
-# DEFINE_slurp | apreq_xs_upload_slurp |
-# DEFINE_size | apreq_xs_upload_size |
-# DEFINE_type | apreq_xs_upload_type |
-# DEFINE_tempname | apreq_xs_upload_tempname |
-# DEFINE_make | apreq_xs_upload_make |
-
-#MODULE=Apache::Upload PACKAGE=Apache::Upload::Table PREFIX=Apache__Upload__Table_
-# DEFINE_get | apreq_xs_upload_table_get |
-# DEFINE_FETCH | apreq_xs_upload_table_FETCH |
-# DEFINE_set | apreq_xs_table_param_set |
-# DEFINE_STORE | apreq_xs_table_param_set |
-# DEFINE_add | apreq_xs_table_param_add |
-# DEFINE_new | apreq_xs_table_request_make |
-# DEFINE_NEXTKEY | apreq_xs_upload_table_NEXTKEY |
-# DEFINE_FIRSTKEY | apreq_xs_upload_table_NEXTKEY |
-# DEFINE_do | apreq_xs_upload_table_do |
-
-#MODULE=Apache::Upload PACKAGE=Apache::Request PREFIX=Apache__Request_
-# DEFINE_upload | apreq_xs_request_upload_get |
-
-#MODULE=Apache::Upload PACKAGE=Apache::Upload::Brigade \
PREFIX=Apache__Upload__Brigade_
-# DEFINE_new | apreq_xs_upload_brigade_copy |
-# DEFINE_TIEHANDLE | apreq_xs_upload_brigade_copy |
-# DEFINE_READ | apreq_xs_upload_brigade_read |
-# DEFINE_READLINE | apreq_xs_upload_brigade_readline |
-
-#MODULE=Apache::Upload PACKAGE=Apache::Upload::IO PREFIX=Apache__Upload__IO_
-# DEFINE_read | apreq_xs_upload_brigade_read |
-# DEFINE_readline | apreq_xs_upload_brigade_readline |
-
-########## Apache::Cookie:: Functions ##########
-
-#MODULE=Apache::Cookie PACKAGE=Apache::Cookie
-# DEFINE_as_string | apreq_xs_cookie_as_string |
-# DEFINE_make | apreq_xs_make_cookie |
-# DEFINE_expires | apreq_xs_cookie_expires |
-# DEFINE_set_attr | apreq_xs_cookie_set_attr |
-# DEFINE_env | apreq_xs_cookie_env |
-# DEFINE_encode | apreq_xs_encode |
-# DEFINE_decode | apreq_xs_decode |
-# const char *:DEFINE_name | apreq_cookie_name(c) | apreq_cookie_t *:c
-# const char *:DEFINE_raw_value| apreq_cookie_value(c) | apreq_cookie_t *:c
-# apr_status_t:DEFINE_bake | apreq_cookie_bake (apreq_xs_sv2cookie(c), \
apreq_xs_sv2env(SvRV(c))) | SV *:c
-# apr_status_t:DEFINE_bake2| apreq_cookie_bake2(apreq_xs_sv2cookie(c), \
apreq_xs_sv2env(SvRV(c))) | SV *:c
-
-#MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Jar PREFIX=Apache__Cookie__Jar_
-# DEFINE_jar | apreq_xs_jar |
-# DEFINE_env | apreq_xs_jar_env |
-# DEFINE_cookies | apreq_xs_jar_get |
-# DEFINE_get | apreq_xs_jar_get |
-# DEFINE_config | apreq_xs_jar_config |
-
-#MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Table PREFIX=Apache__Cookie__Table_
-# DEFINE_get | apreq_xs_table_get |
-# DEFINE_FETCH | apreq_xs_table_FETCH |
-# DEFINE_set | apreq_xs_table_cookie_set |
-# DEFINE_STORE | apreq_xs_table_cookie_set |
-# DEFINE_add | apreq_xs_table_cookie_add |
-# DEFINE_new | apreq_xs_table_jar_make |
-# DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
-# DEFINE_FIRSTKEY | apreq_xs_table_NEXTKEY |
-# DEFINE_do | apreq_xs_table_do |
-
-########## Utility Functions ##########
-
-#MODULE=Apache::Request PACKAGE=Apache::Request::Util PREFIX=apreq_
-# apreq_log
-# apreq_join
-# apreq_index
-# apreq_encode
-# apreq_decode
-# apreq_expires
-
-
#################### APR::Request stuff ####################
MODULE=APR::Request PACKAGE=APR::Request PREFIX=apreq_
@@ -113,42 +9,40 @@
DEFINE_parse | apreq_xs_parse |
MODULE=APR::Request::Apache2 PACKAGE=APR::Request::Apache2 \
PREFIX=APR__Request__Apache2_
-apreq_xs_handle_apache2_t *:DEFINE_new | apreq_handle_apache2 (r) | const char \
*:class, request_rec *:r +apreq_xs_handle_apache2_t *:DEFINE_handle | \
apreq_handle_apache2 (r) | const char *:class, request_rec *:r
MODULE=APR::Request::CGI PACKAGE=APR::Request::CGI PREFIX=APR__Request__CGI_
-apreq_xs_handle_cgi_t *:DEFINE_new | apreq_handle_cgi (p) | const char *:class, \
apr_pool_t *:p +apreq_xs_handle_cgi_t *:DEFINE_handle | apreq_handle_cgi (p) | const \
char *:class, apr_pool_t *:p
#################### APR::Request::Cookie stuff ####################
MODULE=APR::Request::Cookie PACKAGE=APR::Request::Cookie PREFIX=apreq_cookie_
apreq_cookie_expires
-MODULE=APR::Request::Cookie PACKAGE=APR::Request PREFIX=APR__Request_
-DEFINE_jar | apreq_xs_jar |
-
MODULE=APR::Request::Cookie PACKAGE=APR::Request::Cookie::Table \
PREFIX=APR__Request__Cookie__Table_
-DEFINE_get | apreq_xs_table_FETCH |
-DEFINE_FETCH | apreq_xs_table_FETCH |
-#DEFINE_new | apreq_xs_table_make |
-DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
-DEFINE_FIRSTKEY | apreq_xs_table_NEXTKEY |
-#DEFINE_do | apreq_xs_table_do |
+DEFINE_get | apreq_xs_cookie_table_FETCH |
+DEFINE_FETCH | apreq_xs_cookie_table_FETCH |
+#DEFINE_new | apreq_xs_cookie_table_make |
+DEFINE_NEXTKEY | apreq_xs_cookie_table_NEXTKEY |
+DEFINE_FIRSTKEY | apreq_xs_cookie_table_NEXTKEY |
+#DEFINE_do | apreq_xs_cookie_table_do |
#################### APR::Request::Param stuff ####################
-MODULE=APR::Request::Param PACKAGE=APR::Request PREFIX=APR__Request_
+MODULE=APR::Request PACKAGE=APR::Request PREFIX=APR__Request_
DEFINE_args | apreq_xs_args |
DEFINE_body | apreq_xs_body |
DEFINE_param | apreq_xs_param |
+DEFINE_jar | apreq_xs_jar |
MODULE=APR::Request::Param PACKAGE=APR::Request::Param::Table \
PREFIX=APR__Request__Param__Table_
-DEFINE_get | apreq_xs_table_FETCH |
-DEFINE_FETCH | apreq_xs_table_FETCH |
-#DEFINE_new | apreq_xs_table_make |
-DEFINE_NEXTKEY | apreq_xs_table_NEXTKEY |
-DEFINE_FIRSTKEY | apreq_xs_table_NEXTKEY |
-#DEFINE_do | apreq_xs_table_do |
+DEFINE_get | apreq_xs_param_table_FETCH |
+DEFINE_FETCH | apreq_xs_param_table_FETCH |
+#DEFINE_new | apreq_xs_param_table_make |
+DEFINE_NEXTKEY | apreq_xs_param_table_NEXTKEY |
+DEFINE_FIRSTKEY | apreq_xs_param_table_NEXTKEY |
+#DEFINE_do | apreq_xs_param_table_do |
MODULE=APR::Request::Param PACKAGE=APR::Request::Brigade \
PREFIX=APR__Request__Brigade_ DEFINE_new | apreq_xs_brigade_copy |
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic