joes 2004/07/04 10:44:34
Modified: . CHANGES
glue/perl/t/apreq request.t
glue/perl/t/response/TestApReq request.pm
glue/perl/xsbuilder apreq_xs_postperl.h
glue/perl/xsbuilder/Apache/Cookie Apache__Cookie.h
glue/perl/xsbuilder/Apache/Request Apache__Request.h
glue/perl/xsbuilder/Apache/Upload Apache__Upload.h Upload_pm
glue/perl/xsbuilder/maps apreq_functions.map
Log:
Added $upload->io with a TIEHANDLE API layered over APR::Brigade.
Also added $obj->pool() method everwhere it made sense to. $upload->fh
goes back to being an APR::PerlIO object, which is seekable but less
efficient, and currently suffers some portability issues associated
with largefile support in perl and apr.
Revision Changes Path
1.50 +4 -4 httpd-apreq-2/CHANGES
Index: CHANGES
===================================================================
RCS file: /home/cvs/httpd-apreq-2/CHANGES,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- CHANGES 3 Jul 2004 15:45:53 -0000 1.49
+++ CHANGES 4 Jul 2004 17:44:34 -0000 1.50
@@ -4,10 +4,10 @@
@section v2_04_dev Changes with libapreq2-2.04-dev
- Perl API [joes]
- Replaced APR::PerlIO implementation of $upload->fh with a TIEHANDLE
- API layered over APR::Brigade. Without this change, one filehandle's
- seek pointer could become stale after another handle (on the same upload)
- is read from.
+ Added $upload->io with a TIEHANDLE API layered over APR::Brigade.
$upload->fh
+ remains implemented as an APR::PerlIO object, which is seekable but less
efficient
+ and currently suffers some portability issues associated with largefile
support
+ in perl and apr.
- Perl API [joes]
Added apreq_xs_croak for throwing APR::Error exceptions and included
1.14 +9 -4 httpd-apreq-2/glue/perl/t/apreq/request.t
Index: request.t
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/apreq/request.t,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- request.t 3 Jul 2004 15:45:53 -0000 1.13
+++ request.t 4 Jul 2004 17:44:34 -0000 1.14
@@ -6,7 +6,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET_BODY UPLOAD_BODY);
-plan tests => 12, have_lwp;
+plan tests => 15, have_lwp;
my $location = "/TestApReq__request";
#print GET_BODY $location;
@@ -20,9 +20,9 @@
"basic param");
}
-for my $test (qw/slurp bb_read fh_read tempname bad;query=string%%/) {
+for my $test (qw/slurp bb tempname fh io bad;query=string%%/) {
# upload a string as a file
- my $value = ('DataUpload' x 10 . "\r\n") x 100;
+ my $value = ('DataUpload' x 10 . "\r\n") x 1_000;
my $result = UPLOAD_BODY("$location?test=$test", content => $value);
ok t_cmp($value, $result, "basic upload");
my $i;
@@ -35,6 +35,11 @@
{
my $value = 'DataUpload' x 100;
+ my $result = UPLOAD_BODY("$location?test=type", content => $value);
+ ok t_cmp("text/plain", $result, "type");
+}
+{
+ my $value = 'DataUpload' x 100;
my $result = UPLOAD_BODY("$location?test=disable_uploads", content =>
$value);
ok t_cmp("ok", $result, "disabled uploads");
-}
\ No newline at end of file
+}
1.19 +35 -18 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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- request.pm 4 Jul 2004 04:32:29 -0000 1.18
+++ request.pm 4 Jul 2004 17:44:34 -0000 1.19
@@ -11,8 +11,6 @@
use APR::Pool;
use APR::PerlIO;
-my $p = APR::Pool->new();
-
sub handler {
my $r = shift;
my $req = Apache::Request->new($r);
@@ -35,7 +33,7 @@
}
$req->print($data);
}
- elsif ($test eq 'bb_read') {
+ elsif ($test eq 'bb') {
my ($upload) = $req->upload("HTTPUPLOAD");
my $bb = $upload->bb;
my $e = $bb->first;
@@ -45,29 +43,42 @@
$e = $bb->next($e);
}
}
- elsif ($test eq 'fh_read') {
+ elsif ($test eq 'tempname') {
+ my $upload = $req->upload("HTTPUPLOAD");
+ my $name = $upload->tempname;
+ open my $fh, "<:APR", $name, $upload->pool or die "Can't open $name:
$!";
+ $r->print(<$fh>);
+ }
+ elsif ($test eq 'fh') {
my $upload = $req->upload(($req->upload)[0]);
my $fh = $upload->fh;
- die "content-type mismatch" unless $upload->info->{"Content-Type"}
eq $upload->type;
- read $upload->fh, my $contents, $upload->size;
- $upload->slurp(my $data);
- die "fh contents != slurp data" unless $contents eq $data;
+ read $upload->fh, my $fh_contents, $upload->size;
+ $upload->slurp(my $slurp_data);
+ die 'fh contents != slurp data'
+ unless $fh_contents eq $slurp_data;
+ read $fh, $fh_contents, $upload->size;
+ die '$fh contents != slurp data'
+ unless $fh_contents eq $slurp_data;
+ seek $fh, 0, 0;
+ $r->print(<$fh>);
+ }
+ elsif ($test eq 'io') {
+ my $upload = $req->upload(($req->upload)[0]);
+ my $io = $upload->io;
+ read $upload->io, my $io_contents, $upload->size;
+ $upload->slurp(my $slurp_data);
+ die "io contents != slurp data" unless $io_contents eq $slurp_data;
my $bb = $upload->bb;
my $e = $bb->first;
- my $brigade_contents = "";
+ my $bb_contents = "";
while ($e) {
$e->read(my $buf);
- $brigade_contents .= $buf;
+ $bb_contents .= $buf;
$e = $bb->next($e);
}
- die "brigade contents != slurp data" unless $brigade_contents eq
$data;
- $r->print(<$fh>);
-
- }
- elsif ($test eq 'tempname') {
- my $upload = $req->upload("HTTPUPLOAD");
- open my $fh, "<:APR", $upload->tempname, $p or die $!;
- $r->print(<$fh>);
+ die "io contents != brigade contents"
+ unless $io_contents eq $bb_contents;
+ $r->print(<$io>);
}
elsif ($test eq 'bad') {
eval {my $q = $req->args('query')};
@@ -75,6 +86,12 @@
$req->upload("HTTPUPLOAD")->slurp(my $data);
$req->print($data);
}
+ }
+ elsif ($test eq 'type') {
+ my $upload = $req->upload("HTTPUPLOAD");
+ die "content-type mismatch"
+ unless $upload->info->{"Content-Type"} eq $upload->type;
+ $r->print($upload->type);
}
elsif ($test eq 'disable_uploads') {
$req->config(DISABLE_UPLOADS => 1);
1.35 +14 -0 httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h
Index: apreq_xs_postperl.h
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/xsbuilder/apreq_xs_postperl.h,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- apreq_xs_postperl.h 3 Jul 2004 18:16:05 -0000 1.34
+++ apreq_xs_postperl.h 4 Jul 2004 17:44:34 -0000 1.35
@@ -395,6 +395,20 @@
Perl_croak(aTHX_ Nullch);
}
+#define APREQ_XS_DEFINE_POOL(attr) \
+static XS(apreq_xs_##attr##_pool) \
+{ \
+ dXSARGS; \
+ void *env; \
+ \
+ if (items != 1 || !SvROK(ST(0))) \
+ Perl_croak(aTHX_ "Usage: $obj->pool()"); \
+ env = apreq_xs_##attr##_sv2env(ST(0)); \
+ ST(0) = sv_2mortal(sv_setref_pv(newSV(0), "APR::Pool", \
+ apreq_env_pool(env))); \
+ XSRETURN(1); \
+}
+
/** @} */
#endif /* APREQ_XS_POSTPERL_H */
1.22 +2 -0
httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Apache__Cookie.h
Index: Apache__Cookie.h
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Cookie/Apache__Cookie.h,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- Apache__Cookie.h 2 Jul 2004 04:40:08 -0000 1.21
+++ Apache__Cookie.h 4 Jul 2004 17:44:34 -0000 1.22
@@ -71,6 +71,8 @@
APREQ_XS_DEFINE_GET(jar, TABLE_PKG, cookie, COOKIE_PKG, 1);
APREQ_XS_DEFINE_GET(table, TABLE_PKG, cookie, COOKIE_PKG, 1);
+APREQ_XS_DEFINE_POOL(jar);
+APREQ_XS_DEFINE_POOL(table);
/**
*Returns serialized version of cookie.
1.35 +3 -0
httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Apache__Request.h
Index: Apache__Request.h
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Request/Apache__Request.h,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -r1.34 -r1.35
--- Apache__Request.h 3 Jul 2004 18:16:05 -0000 1.34
+++ Apache__Request.h 4 Jul 2004 17:44:34 -0000 1.35
@@ -134,6 +134,9 @@
APREQ_XS_DEFINE_GET(body, PARAM_TABLE, param, NULL, 1);
APREQ_XS_DEFINE_GET(table, PARAM_TABLE, param, NULL, 1);
+APREQ_XS_DEFINE_POOL(request);
+APREQ_XS_DEFINE_POOL(table);
+
static XS(apreq_xs_request_config)
{
dXSARGS;
1.14 +1 -0
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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- Apache__Upload.h 3 Jul 2004 18:16:05 -0000 1.13
+++ Apache__Upload.h 4 Jul 2004 17:44:34 -0000 1.14
@@ -109,6 +109,7 @@
APREQ_XS_DEFINE_GET(upload_table, UPLOAD_TABLE, param, UPLOAD_PKG, 1);
APREQ_XS_DEFINE_ENV(upload);
+APREQ_XS_DEFINE_POOL(upload_table);
APR_INLINE
static XS(apreq_xs_upload_link)
1.8 +11 -1 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Upload_pm 4 Jul 2004 03:53:52 -0000 1.7
+++ Upload_pm 4 Jul 2004 17:44:34 -0000 1.8
@@ -1,14 +1,24 @@
use APR::Table;
use APR::Bucket;
use APR::Brigade;
+use APR::PerlIO;
use APR::Error;
use Apache::Request;
package Apache::Upload;
-sub fh {
+
+sub io {
tie local (*FH), "Apache::Upload::Brigade", shift->bb;
return *FH{IO};
}
+
+sub fh {
+ my $upload = shift;
+ open my $fh, "<:APR", $upload->tempname, $upload->pool or
+ die "Can't open ", $upload->tempname, ": ", $!;
+ return $fh;
+}
+
package Apache::Upload::Error;
push our(@ISA), "APR::Error";
1.27 +8 -3
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.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- apreq_functions.map 3 Jul 2004 15:45:53 -0000 1.26
+++ apreq_functions.map 4 Jul 2004 17:44:34 -0000 1.27
@@ -10,12 +10,13 @@
DEFINE_body | apreq_xs_body_get |
DEFINE_config | apreq_xs_request_config |
DEFINE_parse | apreq_xs_request_parse |
+ DEFINE_pool | apreq_xs_request_pool |
apr_status_t:DEFINE_body_status |
apreq_parse_request(apreq_xs_sv2(request,sv),NULL) | SV *:sv
MODULE=Apache::Request PACKAGE=Apache::Request::Table
PREFIX=Apache__Request__Table_
DEFINE_get | apreq_xs_table_get |
DEFINE_FETCH | apreq_xs_table_get |
-
+ DEFINE_pool | apreq_xs_table_pool |
########## Apache::Upload:: Functions ##########
@@ -28,11 +29,13 @@
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_tempname | apreq_xs_upload_tempname |
+ DEFINE_pool | apreq_xs_upload_table_pool |
MODULE=Apache::Upload PACKAGE=Apache::Upload::Table
PREFIX=Apache__Upload__Table_
DEFINE_get | apreq_xs_upload_table_get |
DEFINE_FETCH | apreq_xs_upload_table_get |
+ DEFINE_pool | apreq_xs_upload_table_pool |
MODULE=Apache::Upload PACKAGE=Apache::Request PREFIX=Apache__Request_
DEFINE_upload | apreq_xs_upload_get |
@@ -53,6 +56,7 @@
DEFINE_env | apreq_xs_cookie_env |
DEFINE_encode | apreq_xs_encode |
DEFINE_decode | apreq_xs_decode |
+ DEFINE_pool | apreq_xs_table_pool |
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
@@ -63,11 +67,12 @@
DEFINE_env | apreq_xs_jar_env |
DEFINE_cookie | apreq_xs_jar_get |
DEFINE_get | apreq_xs_jar_get |
+ DEFINE_pool | apreq_xs_jar_pool |
MODULE=Apache::Cookie PACKAGE=Apache::Cookie::Table
PREFIX=Apache__Cookie__Table_
DEFINE_get | apreq_xs_table_get |
DEFINE_FETCH | apreq_xs_table_get |
-
+ DEFINE_pool | apreq_xs_table_pool |
########## Utility Functions ##########
