joes 2004/06/29 15:45:30
Modified: . CHANGES
build xsbuilder.pl
glue/perl/t/apreq request.t
glue/perl/t/response/TestApReq request.pm
glue/perl/xsbuilder/Apache/Upload Apache__Upload.h
Upload_pod
glue/perl/xsbuilder/maps apreq_functions.map
Log:
Fix typo in T_HASHOBJ override and add back tempnam() support, per user
request.
Revision Changes Path
1.47 +1 -1 httpd-apreq-2/CHANGES
Index: CHANGES
===================================================================
RCS file: /home/cvs/httpd-apreq-2/CHANGES,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- CHANGES 29 Jun 2004 18:34:48 -0000 1.46
+++ CHANGES 29 Jun 2004 22:45:30 -0000 1.47
@@ -5,7 +5,7 @@
- Perl API [joes]
Added $jar->status, $req->args_status and $req->body_status to report
- parsing errors.
+ parsing errors. Also add $upload->tempname per user request.
- C API [joes]
Dropped status attribute of apreq_value_t. Added status field to
1.26 +1 -2 httpd-apreq-2/build/xsbuilder.pl
Index: xsbuilder.pl
===================================================================
RCS file: /home/cvs/httpd-apreq-2/build/xsbuilder.pl,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- xsbuilder.pl 29 Jun 2004 21:36:15 -0000 1.25
+++ xsbuilder.pl 29 Jun 2004 22:45:30 -0000 1.26
@@ -462,7 +462,6 @@
},
T_HASHOBJ => {
INPUT => <<'EOT', # '$var =
modperl_hash_tied_object(aTHX_ \"${ntype}\", $arg)'
-
if (sv_derived_from($arg, \"${ntype}\")) {
if (SVt_PVHV == SvTYPE(SvRV($arg))) {
SV *hv = SvRV($arg);
@@ -488,7 +487,7 @@
else {
Perl_croak(aTHX_
\"argument is not a blessed reference \"
- \"(expecting an %s derived object)\", "\${ntype}\");
+ \"(expecting an %s derived object)\", \"${ntype}\");
}
EOT
1.9 +2 -2 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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- request.t 26 Jun 2004 20:30:40 -0000 1.8
+++ request.t 29 Jun 2004 22:45:30 -0000 1.9
@@ -6,7 +6,7 @@
use Apache::TestUtil;
use Apache::TestRequest qw(GET_BODY UPLOAD_BODY);
-plan tests => 7, have_lwp;
+plan tests => 9, have_lwp;
my $location = "/TestApReq__request";
#print GET_BODY $location;
@@ -20,7 +20,7 @@
"basic param");
}
-for my $test (qw/slurp bb_read fh_read/) {
+for my $test (qw/slurp bb_read fh_read tempfile/) {
# upload a string as a file
my $value = 'DataUpload' x 100_000;
my $result = UPLOAD_BODY("$location?test=$test", content => $value);
1.13 +5 -0 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.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- request.pm 28 Jun 2004 21:58:15 -0000 1.12
+++ request.pm 29 Jun 2004 22:45:30 -0000 1.13
@@ -47,6 +47,11 @@
return unless $upload->info->{"Content-Type"} eq $upload->type;
$r->print(<$fh>);
}
+ elsif ($test eq 'tempfile') {
+ my $upload = $req->upload("HTTPUPLOAD");
+ open my $fh, "<", $upload->tempfile or die $!;
+ $r->print(<$fh>);
+ }
return 0;
}
1.8 +56 -1
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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Apache__Upload.h 28 Jun 2004 21:58:15 -0000 1.7
+++ Apache__Upload.h 29 Jun 2004 22:45:30 -0000 1.8
@@ -342,6 +342,62 @@
XSRETURN(1);
}
+static XS(apreq_xs_upload_tempfile)
+{
+ dXSARGS;
+ MAGIC *mg;
+ void *env;
+ apr_bucket_brigade *bb;
+ apr_status_t s;
+ apr_file_t *file;
+ const char *path;
+
+ if (items != 1 || !SvROK(ST(0)))
+ Perl_croak(aTHX_ "Usage: $upload->temp_file()");
+
+ if (!(mg = mg_find(SvRV(ST(0)), PERL_MAGIC_ext)))
+ Perl_croak(aTHX_ "$upload->temp_file(): can't find env");
+
+ env = mg->mg_ptr;
+ bb = apreq_xs_sv2param(ST(0))->bb;
+ file = apreq_brigade_spoolfile(bb);
+
+ if (file == NULL) {
+ apr_bucket *last;
+ apr_off_t len;
+ const char *tmpdir = apreq_env_temp_dir(env, NULL);
+
+ s = apreq_file_mktemp(&file, apreq_env_pool(env), tmpdir);
+
+ if (s != APR_SUCCESS) {
+ apreq_log(APREQ_ERROR s, env, "apreq_xs_upload_temp_file:"
+ "apreq_file_mktemp failed");
+ Perl_croak(aTHX_ "$upload->temp_file: can't make tempfile");
+ }
+
+ s = apreq_brigade_fwrite(file, &len, bb);
+
+ if (s != APR_SUCCESS) {
+ apreq_log(APREQ_ERROR s, env, "apreq_xs_upload_fh:"
+ "apreq_brigade_fwrite failed");
+ Perl_croak(aTHX_ "$upload->temp_file: can't write brigade to
tempfile");
+ }
+
+ last = apr_bucket_file_create(file, len, 0, bb->p, bb->bucket_alloc);
+ APR_BRIGADE_INSERT_TAIL(bb, last);
+ }
+
+ s = apr_file_name_get(&path, file);
+ if (s != APR_SUCCESS)
+ XSRETURN_UNDEF;
+
+ ST(0) = sv_2mortal(newSVpvn(path, strlen(path)));
+ XSRETURN(1);
+}
+
+
+#ifdef IMPLEMENT_UPLOAD_HOOKS
+
struct hook_ctx {
SV *hook_data;
SV *hook;
@@ -350,7 +406,6 @@
PerlInterpreter *perl;
};
-#ifdef IMPLEMENT_UPLOAD_HOOKS
#define DEREF(slot) if (ctx->slot) SvREFCNT_dec(ctx->slot)
1.3 +3 -1
httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Upload_pod
Index: Upload_pod
===================================================================
RCS file:
/home/cvs/httpd-apreq-2/glue/perl/xsbuilder/Apache/Upload/Upload_pod,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- Upload_pod 28 Jun 2004 21:58:15 -0000 1.2
+++ Upload_pod 29 Jun 2004 22:45:30 -0000 1.3
@@ -105,10 +105,12 @@
my $contents;
print $contents if $upload->slurp($contents) == 0;
+=head2 C<tempname()>
+
+Provides the name of the spool file.
=head1 API CHANGES from v1.X to v2.X
-C<tempname> has been removed from the API.
C<info($header)> is replaced by C<info($table)>.
C<type()> returns only the MIME-type portion of the Content-Type header.
1.24 +1 -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.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- apreq_functions.map 29 Jun 2004 18:34:48 -0000 1.23
+++ apreq_functions.map 29 Jun 2004 22:45:30 -0000 1.24
@@ -29,6 +29,7 @@
DEFINE_size | apreq_xs_upload_size |
DEFINE_fh | apreq_xs_upload_fh |
DEFINE_type | apreq_xs_upload_type |
+ DEFINE_tempfile | apreq_xs_upload_tempfile |
MODULE=Apache::Upload PACKAGE=Apache::Upload::Table
PREFIX=Apache__Upload__Table_
DEFINE_get | apreq_xs_upload_table_get |
