randyk 2004/07/23 16:52:14
Modified: . FAQ.pod
glue/perl/t/response/TestApReq request.pm
glue/perl/t/response/TestApReq upload.pm
glue/perl/xsbuilder/Apache/Upload Upload_pm
Log:
Submitted by: Markus Wichitill <mawic () gmx ! de>
Reviewed by: randyk
with the removal of APR_DELONCLOSE in apreq_file_mktemp, and instead
register a pool cleanup to delete the temp file, we no longer need
to open temp files on Win32 using ":APR".
Revision Changes Path
1.4 +0 -13 httpd-apreq-2/FAQ.pod
Index: FAQ.pod
===================================================================
RCS file: /home/cvs/httpd-apreq-2/FAQ.pod,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- FAQ.pod 4 Jul 2004 19:41:13 -0000 1.3
+++ FAQ.pod 23 Jul 2004 23:52:14 -0000 1.4
@@ -29,19 +29,6 @@
C<use Apache::Upload> to load the C<Apache::Request::upload> function.
-=head2 On Win32, I can't open an uploaded file specified by
$upload-E<gt>tempname
-
-C<tempname> in libapreq2 enables a flag that will delete the temporary
-file after it's closed. On Win32, however, use of Perl's C<open()>
-to open this file causes a premature deletion. Use instead the
-APR::PerlIO layer to open this file:
-
- use APR::PerlIO;
- ...
- my $name = $upload->tempname;
- open my $fh, "<:APR", $name, $upload->pool or die "Can't open $name: $!";
- ...
-
=head1 Using libapreq2 outside of Apache.
[...]
1.36 +4 -21 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.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- request.pm 23 Jul 2004 07:21:14 -0000 1.35
+++ request.pm 23 Jul 2004 23:52:14 -0000 1.36
@@ -12,7 +12,6 @@
use APR::PerlIO;
use Apache::ServerUtil;
use File::Spec;
-use constant WIN32 => $^O eq 'MSWin32';
my $data;
@@ -27,7 +26,8 @@
sub handler {
my $r = shift;
- my $temp_dir = $r->server->server_root_relative('logs');
+ my $temp_dir =
+ File::Spec->catfile(Apache::ServerUtil::server_root, 'logs');
my $req = Apache::Request->new($r, POST_MAX => 1_000_000,
TEMP_DIR => $temp_dir);
@@ -73,16 +73,7 @@
chop $dir;
die "Tempfile in wrong temp_dir (expected $temp_dir, saw $dir)"
unless
$dir eq $temp_dir;
-
- my $fh;
- if (WIN32) {
- open $fh, "<:APR", $name, $upload->pool
- or die "Can't open $name: $!";
- }
- else {
- open $fh, "<", $name
- or die "Can't open $name: $!";
- }
+ open my $fh, "<", $name or die "Can't open $name: $!";
$r->print(<$fh>);
}
elsif ($test eq 'link') {
@@ -90,15 +81,7 @@
my $link_file = File::Spec->catfile("$temp_dir", "linktest");
unlink $link_file if -f $link_file;
$upload->link($link_file) or die "Can't link to $link_file: $!";
- my $fh;
- if (WIN32) {
- open $fh, "<:APR", $link_file, $upload->pool
- or die "Can't open $link_file: $!";
- }
- else {
- open $fh, "<", $link_file
- or die "Can't open $link_file: $!";
- }
+ open my $fh, "<", $link_file or die "Can't open $link_file: $!";
$r->print(<$fh>);
}
elsif ($test eq 'fh') {
1.3 +3 -18 httpd-apreq-2/glue/perl/t/response/TestApReq/upload.pm
Index: upload.pm
===================================================================
RCS file: /home/cvs/httpd-apreq-2/glue/perl/t/response/TestApReq/upload.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- upload.pm 23 Jul 2004 06:36:35 -0000 1.2
+++ upload.pm 23 Jul 2004 23:52:14 -0000 1.3
@@ -9,7 +9,6 @@
use Apache::Upload;
use File::Spec;
require File::Basename;
-use constant WIN32 => $^O eq 'MSWin32';
sub handler {
my $r = shift;
@@ -32,14 +31,7 @@
}
elsif ($method eq 'tempname') {
my $name = $upload->tempname;
- if (WIN32) {
- open $fh, "<:APR", $name, $upload->pool
- or die "Can't open $name: $!";
- }
- else {
- open $fh, "<", $name
- or die "Can't open $name: $!";
- }
+ open $fh, "<", $name or die "Can't open $name: $!";
binmode $fh;
read $fh, $data, $upload->size;
close $fh;
@@ -48,21 +40,14 @@
my $link_file = File::Spec->catfile($temp_dir, "linkfile");
unlink $link_file if -f $link_file;
$upload->link($link_file) or die "Can't link to $link_file: $!";
- if (WIN32) {
- open $fh, "<:APR", $link_file, $upload->pool
- or die "Can't open $link_file: $!";
- }
- else {
- open $fh, "<", $link_file
- or die "Can't open $link_file: $!";
- }
+ open $fh, "<", $link_file or die "Can't open $link_file: $!";
binmode $fh;
read $fh, $data, $upload->size;
close $fh;
unlink $link_file if -f $link_file;
}
elsif ($method eq 'io') {
- read $upload->io, $data, $upload->size;
+ read $upload->io, $data, $upload->size;
}
else {
die "unknown method: $method";
1.13 +3 -9 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.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- Upload_pm 23 Jul 2004 06:36:35 -0000 1.12
+++ Upload_pm 23 Jul 2004 23:52:14 -0000 1.13
@@ -14,15 +14,9 @@
sub fh {
my $upload = shift;
- my $fh;
- if ($^O eq 'MSWin32') {
- open $fh, "<:APR", $upload->tempname, $upload->pool
- or die "Can't open ", $upload->tempname, ": ", $!;
- }
- else {
- open $fh, "<", $upload->tempname
- or die "Can't open ", $upload->tempname, ": ", $!;
- }
+ open my $fh, "<", $upload->tempname
+ or die "Can't open ", $upload->tempname, ": ", $!;
+ binmode $fh;
return $fh;
}
