This is following up on a change made in
xs/APR/PerlIO/apr_perlio.c
concerning the addition of PERLIO_K_RAW:
http://marc.theaimsgroup.com/?l=apache-modperl-cvs&m=106264631819673&w=2
At the time there wasn't a test that showed this change was
needed (there are tests that show PERLIO_K_RAW is needed for
src/modules/perl/modperl_io_apache.c). Some tests that do
show this appear below, but they're subtle.
If I understand things correctly, the apr layer opens files
in binary mode (on, eg, Win32, where it makes a difference).
What this means for the Perl glue is that, when
opening a file
open($fh, ">:APR", ...)
$fh is already in "binmode". For binary files this
is "good", but it also means text files are opened in
binary mode, with \015\012 line endings. For example, in
local $/;
open $apr_fh, "<:APR", $file, $r->pool;
$apr_content = <$fh>;
close $apr_fh;
open $perl_fh, "<", $file;
binmode($perl_fh);
$perl_content = <$fh>;
close $apr_fh;
the lengths of $apr_content and $perl_content are the
same only with the binmode($perl_fh) call, for both
text and binary files.
This test works both with and without the addition of
PERLIO_K_RAW to xs/APR/PerlIO/apr_perlio.c. Where a
difference arises is if one does an explicit
binmode($apr_fh) - if done, then the PERLIO_K_RAW is needed,
as otherwise the filehandle, for example, outputs nothing.
So, what the addition of PERLIO_K_RAW apparently does is
make a Perl binmode($apr_fh) call redundant - it doesn't do
anything, but it doesn't hurt.
I also added in a few tests regarding writing and reading
text files, and testing that things work as expected as far
as \015\012 issues are involved. But as far as testing
whether or not PERLIO_K_RAW is needed, the critical
point in the tests is the presence of binmode($apr_fh).
================================================================
Index: t/response/TestAPR/perlio.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/perlio.pm,v
retrieving revision 1.25
diff -u -r1.25 perlio.pm
--- t/response/TestAPR/perlio.pm 19 Sep 2003 19:54:37 -0000 1.25
+++ t/response/TestAPR/perlio.pm 28 Sep 2003 02:01:55 -0000
@@ -28,7 +28,7 @@
sub handler {
my $r = shift;
- my $tests = 11;
+ my $tests = 21;
$tests += 3 unless LARGE_FILES_CONFLICT;
$tests += 1 unless APR_WIN32_FILE_DUP_BUG;
@@ -221,6 +221,80 @@
}
+ # test reading and writing text and binary files
+ {
+ my $data_dir = 'docs/user/handlers';
+ local $/;
+ my ($rfh, $wfh, $pfh);
+ for my $file ('general.pod', 'filter_logic.png') {
+ my $in = catfile $vars->{top_dir}, $data_dir, $file;
+ my $out = catfile $dir, $file;
+ open $rfh, "<:APR", $in, $r->pool
+ or die "Cannot open $in for reading: $!";
+ my $apr_content = <$rfh>;
+ close $rfh;
+ open $pfh, "<", $in
+ or die "Cannot open $in for reading: $!";
+ binmode($pfh);
+ my $perl_content = <$pfh>;
+ close $pfh;
+ ok t_cmp(length $perl_content,
+ length $apr_content,
+ "testing data size of $file");
+
+ open $wfh, ">:APR", $out, $r->pool
+ or die "Cannot open $out for writing: $!";
+ binmode($wfh);
+ print $wfh $apr_content;
+ close $wfh;
+ ok t_cmp(-s $in,
+ -s $out,
+ "testing file size of $file");
+ }
+
+ my $crlf = catfile $dir, "crlf$$.dat";
+ my $text;
+ open $wfh, ">:crlf", $crlf
+ or die "Cannot open $crlf for writing: $!";
+ print $wfh 'a'.((('a' x 14).qq{\n}) x 2000);
+ close $wfh;
+ open $rfh, "<:APR", $crlf, $r->pool
+ or die "Cannot open $crlf for reading: $!";
+ binmode($rfh);
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp(2000,
+ count_chars($text, "\015\012"),
+ 'testing for presence of \015\012');
+ ok t_cmp(2000,
+ count_chars($text, "\n"),
+ 'testing for presence of \n');
+
+ open $wfh, ">:APR", $crlf, $r->pool
+ or die "Cannot open $crlf for writing: $!";
+ print $wfh 'a'.((('a' x 14).qq{\r\n}) x 2000);
+ close $wfh;
+ open $rfh, "<:APR", $crlf, $r->pool
+ or die "Cannot open $crlf for reading: $!";
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp(2000,
+ count_chars($text, "\015\012"),
+ 'testing for presence of \015\012');
+ ok t_cmp(2000,
+ count_chars($text, "\n"),
+ 'testing for presence of \n');
+ open $rfh, "<:crlf", $crlf
+ or die "Cannot open $crlf for reading: $!";
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp(0,
+ count_chars($text, "\015\012"),
+ 'testing for presence of \015\012');
+ ok t_cmp(2000,
+ count_chars($text, "\n"),
+ 'testing for presence of \n');
+ }
# XXX: need tests
# - for stdin/out/err as they are handled specially
@@ -232,6 +306,13 @@
# cleanup: t_mkdir will remove the whole tree including the file
Apache::OK;
+}
+
+sub count_chars {
+ my($text, $chars) = @_;
+ my $seen = 0;
+ $seen++ while $text =~ /$chars/g;
+ return $seen;
}
1;
==============================================================
--
best regards,
randy
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
