joes 2004/07/24 08:10:13
Modified: glue/perl/t/response/TestApReq request.pm
glue/perl/xsbuilder/Apache/Upload Apache__Upload.h Upload_pm
glue/perl/xsbuilder/maps apreq_functions.map
Log:
Drop bogus ::Request package from Apache::Upload::Brigade error messages, and
do Apache::Upload::AUTOLOAD's tied dispatch directly in C (instead of perl ops)
for better efficiency.
Revision Changes Path
1.37 +5 -1 httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm
Index: request.pm
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/request.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- request.pm 23 Jul 2004 23:52:14 -0000 1.36
+++ request.pm 24 Jul 2004 15:10:12 -0000 1.37
@@ -103,6 +103,10 @@
read $upload->io, my $io_contents, $upload->size;
$upload->slurp(my $slurp_data);
die "io contents != slurp data" unless $io_contents eq $slurp_data;
+ undef $io_contents;
+ $upload->io->read($io_contents, $upload->size);
+ die "io contents != slurp data" unless $io_contents eq $slurp_data;
+
my $bb = $upload->bb;
my $e = $bb->first;
my $bb_contents = "";
@@ -111,7 +115,7 @@
$bb_contents .= $buf;
$e = $bb->next($e);
}
- die "io contents != brigade contents"
+ die "io contents != brigade contents"
unless $io_contents eq $bb_contents;
$r->print(<$io>);
}
1.29 +34 -8
httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Apache__Upload.h
Index: Apache__Upload.h
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Apache__Upload.h,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- Apache__Upload.h 23 Jul 2004 07:21:15 -0000 1.28
+++ Apache__Upload.h 24 Jul 2004 15:10:12 -0000 1.29
@@ -287,17 +287,43 @@
XSRETURN(1);
}
+APR_INLINE
+static SV *apreq_xs_find_bb_obj(pTHX_ SV *in)
+{
+ while (in && SvROK(in)) {
+ SV *sv = SvRV(in);
+ switch (SvTYPE(sv)) {
+ MAGIC *mg;
+ case SVt_PVIO:
+ if (SvMAGICAL(sv) && (mg = mg_find(sv,PERL_MAGIC_tiedscalar))) {
+ in = mg->mg_obj;
+ break;
+ }
+ Perl_croak(aTHX_ "panic: cannot find tied scalar in pvio magic");
+ case SVt_PVMG:
+ if (SvOBJECT(sv) && SvIOK(sv))
+ return sv;
+ default:
+ Perl_croak(aTHX_ "panic: unsupported SV type: %d", SvTYPE(sv));
+ }
+ }
+ return NULL;
+}
+
+
static XS(apreq_xs_upload_brigade_copy)
{
dXSARGS;
apr_bucket_brigade *bb, *bb_copy;
char *class;
+ SV *obj;
if (items != 2 || !SvPOK(ST(0)) || !SvROK(ST(1)))
Perl_croak(aTHX_ "Usage: Apache::Upload::Brigade->new($bb)");
class = SvPV_nolen(ST(0));
- bb = (apr_bucket_brigade *)SvIVX(SvRV(ST(1)));
+ obj = apreq_xs_find_bb_obj(aTHX_ ST(1));
+ bb = (apr_bucket_brigade *)SvIVX(obj);
bb_copy = apr_brigade_create(bb->p,bb->bucket_alloc);
APREQ_BRIGADE_COPY(bb_copy, bb);
@@ -323,7 +349,7 @@
case 2:
sv = ST(1);
if (SvROK(ST(0))) {
- obj = SvRV(ST(0));
+ obj = apreq_xs_find_bb_obj(aTHX_ ST(0));
bb = (apr_bucket_brigade *)SvIVX(obj);
break;
}
@@ -345,7 +371,7 @@
s = apr_bucket_read(e, &data, &dlen, APR_BLOCK_READ);
if (s != APR_SUCCESS)
apreq_xs_croak(aTHX_ newHV(), s,
- "Apache::Request::Upload::Brigade::READ",
+ "Apache::Upload::Brigade::READ",
"APR::Error");
want = dlen;
end = APR_BUCKET_NEXT(e);
@@ -358,7 +384,7 @@
s = apr_brigade_length(bb, 1, &len);
if (s != APR_SUCCESS)
apreq_xs_croak(aTHX_ newHV(), s,
- "Apache::Request::Upload::Brigade::READ",
+ "Apache::Upload::Brigade::READ",
"APR::Error");
want = len;
@@ -367,7 +393,7 @@
default:
apreq_xs_croak(aTHX_ newHV(), s,
- "Apache::Request::Upload::Brigade::READ",
+ "Apache::Upload::Brigade::READ",
"APR::Error");
}
}
@@ -383,7 +409,7 @@
s = apr_bucket_read(e, &data, &dlen, APR_BLOCK_READ);
if (s != APR_SUCCESS)
apreq_xs_croak(aTHX_ newHV(), s,
- "Apache::Request::Upload::Brigade::READ",
"APR::Error");
+ "Apache::Upload::Brigade::READ", "APR::Error");
memcpy(buf, data, dlen);
buf += dlen;
apr_bucket_delete(e);
@@ -405,7 +431,7 @@
if (items != 1 || !SvROK(ST(0)))
Perl_croak(aTHX_ "Usage: $bb->READLINE");
- obj = SvRV(ST(0));
+ obj = apreq_xs_find_bb_obj(aTHX_ ST(0));
bb = (apr_bucket_brigade *)SvIVX(obj);
if (APR_BRIGADE_EMPTY(bb))
@@ -425,7 +451,7 @@
s = apr_bucket_read(e, &data, &dlen, APR_BLOCK_READ);
if (s != APR_SUCCESS)
apreq_xs_croak(aTHX_ newHV(), s,
- "Apache::Request::Upload::Brigade::READLINE",
+ "Apache::Upload::Brigade::READLINE",
"APR::Error");
eol = memchr(data, '\012', dlen); /* look for LF (linefeed) */
1.14 +1 -4 httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Upload_pm
Index: Upload_pm
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Upload_pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- Upload_pm 23 Jul 2004 23:52:14 -0000 1.13
+++ Upload_pm 24 Jul 2004 15:10:12 -0000 1.14
@@ -39,7 +39,4 @@
push our(@ISA), "APR::Brigade";
package Apache::Upload::IO;
-sub AUTOLOAD {
- s/.*:://, tr/a-z/A-Z/ for our $AUTOLOAD;
- tied(*{shift()})->$AUTOLOAD(@_);
-}
+push our(@ISA), ();
1.35 +4 -0
httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map
Index: apreq_functions.map
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/maps/apreq_functions.map,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- apreq_functions.map 22 Jul 2004 03:29:09 -0000 1.34
+++ apreq_functions.map 24 Jul 2004 15:10:13 -0000 1.35
@@ -59,6 +59,10 @@
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
