On Sun, 28 Sep 2003, Ayhan Ulusoy wrote:
> I am worried about this.
> Does 'PERLIO_K_RAW' also make the following call "do nothing" ? :
> binmode($apr_f, 'utf8');
That's a good point ... The binmode($apr_f) call (without a
layer) seems to "do nothing", in the sense of not being
needed as far as apr goes, but PERLIO_K_RAW is necessary in
order to be able to put in a binmode($apr_f). However, with
utf8 data the binmode($apr_f, ':utf8') call is necessary on
the perl side. I added a test for this below - without the
binmode($apr_f, ':utf8') calls, the utf8 test fails for me,
but with these calls, they pass.
============================================================
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 23:49:37 -0000
@@ -28,7 +28,7 @@
sub handler {
my $r = shift;
- my $tests = 11;
+ my $tests = 22;
$tests += 3 unless LARGE_FILES_CONFLICT;
$tests += 1 unless APR_WIN32_FILE_DUP_BUG;
@@ -221,6 +221,96 @@
}
+ # 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: $!";
+ binmode($rfh); # not necessary
+ 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: $!";
+ print $wfh $apr_content;
+ close $wfh;
+ ok t_cmp(-s $in,
+ -s $out,
+ "testing file size of $file");
+ }
+
+ my $dat = catfile $dir, "dat$$.dat";
+ my $text;
+ open $wfh, ">:crlf", $dat
+ or die "Cannot open $dat for writing: $!";
+ print $wfh 'a'.((('a' x 14).qq{\n}) x 2000);
+ close $wfh;
+ open $rfh, "<:APR", $dat, $r->pool
+ or die "Cannot open $dat 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 $wfh, ">:APR", $dat, $r->pool
+ or die "Cannot open $dat for writing: $!";
+ binmode($wfh); # not necessary
+ print $wfh 'a'.((('a' x 14).qq{\r\n}) x 2000);
+ close $wfh;
+ open $rfh, "<:APR", $dat, $r->pool
+ or die "Cannot open $dat 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", $dat
+ or die "Cannot open $dat 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');
+
+ my $utf8 = "\x{042F} \x{0432}\x{0430}\x{0441} \x{043B}\x{044E}";
+ open $wfh, ">:APR", $dat, $r->pool
+ or die "Cannot open $dat for writing: $!";
+ binmode($wfh, ':utf8');
+ print $wfh $utf8;
+ close $wfh;
+ open $rfh, "<:APR", $dat, $r->pool
+ or die "Cannot open $dat for reading: $!";
+ binmode($rfh, ':utf8');
+ $text = <$rfh>;
+ close $rfh;
+ ok t_cmp($utf8,
+ $text,
+ 'utf8 binmode test');
+
+ }
# XXX: need tests
# - for stdin/out/err as they are handled specially
@@ -232,6 +322,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]
