Sounds gooood. Thanks Randy.
-----Message d'origine----- De : Randy Kobes [mailto:[EMAIL PROTECTED] Envoyé : lundi 29 septembre 2003 02:12 À : Ayhan Ulusoy Cc : [EMAIL PROTECTED] Objet : Re: RE : [mp2] PERLIO_K_RAW in apr_perlio.c 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]
