File Coverage

blib/lib/Apache/TestUtil.pm
Criterion Covered Total %
statement 78 202 38.6
branch 12 88 13.6
condition 3 21 14.3
subroutine 21 42 50.0
pod 20 25 80.0
total 134 378 35.4


line stmt bran cond sub pod time code
1             # Licensed to the Apache Software Foundation (ASF) under one or more
2             # contributor license agreements. See the NOTICE file distributed with
3             # this work for additional information regarding copyright ownership.
4             # The ASF licenses this file to You under the Apache License, Version 2.0
5             # (the "License"); you may not use this file except in compliance with
6             # the License. You may obtain a copy of the License at
7             #
8             # http://www.apache.org/licenses/LICENSE-2.0
9             #
10             # Unless required by applicable law or agreed to in writing, software
11             # distributed under the License is distributed on an "AS IS" BASIS,
12             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13             # See the License for the specific language governing permissions and
14             # limitations under the License.
15             #
16             package Apache::TestUtil;
17              
18 2     2   27 use strict;
  2         20  
  2         38  
19 2     2   31 use warnings FATAL => 'all';
  2         23  
  2         37  
20              
21 2     2   29 use File::Find ();
  2         54  
  2         55  
22 2     2   29 use File::Path ();
  2         18  
  2         19  
23 2     2   43 use Exporter ();
  2         30  
  2         18  
24 2     2   28 use Carp ();
  2         17  
  2         19  
25 2     2   27 use Config;
  2         18  
  2         34  
26 2     2   30 use File::Basename qw(dirname);
  2         17  
  2         43  
27 2     2   30 use File::Spec::Functions qw(catfile file_name_is_absolute);
  2         18  
  2         38  
28 2     2   35 use Symbol ();
  2         18  
  2         18  
29 2     2   28 use Fcntl qw(SEEK_END);
  2         18  
  2         40  
30              
31 2     2   30 use Apache::Test ();
  2         20  
  2         27  
32 2     2   30 use Apache::TestConfig ();
  2         18  
  2         21  
33              
34 2     2   28 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %CLEAN);
  2         19  
  2         35  
35              
36             $VERSION = '0.02';
37             @ISA     = qw(Exporter);
38              
39             @EXPORT = qw(t_cmp t_debug t_append_file t_write_file t_open_file
40             t_mkdir t_rmtree t_is_equal t_filepath_cmp
41             t_server_log_error_is_expected t_server_log_warn_is_expected
42             t_client_log_error_is_expected t_client_log_warn_is_expected
43             );
44              
45             @EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown
46             t_catfile_apache t_catfile
47             t_start_error_log_watch t_finish_error_log_watch);
48              
49             %CLEAN = ();
50              
51             $Apache::TestUtil::DEBUG_OUTPUT = \*STDOUT;
52              
53             # 5.005's Data::Dumper has problems to dump certain datastructures
54 2 50   2   42 use constant HAS_DUMPER => eval { $] >= 5.6 && require Data::Dumper; };
  2         20  
  2         22  
  2         55  
55 2     2   32 use constant INDENT => 4;
  2         18  
  2         26  
56              
57             {
58                 my $f;
59                 sub t_start_error_log_watch {
60              
61 0     0 1 0         my $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, 'error_log');
62 0 0       0         open $f, "$name" or die "ERROR: Cannot open $name: $!\n";
63 0         0         seek $f, 0, SEEK_END;
64              
65 0         0         return;
66                 }
67              
68                 sub t_finish_error_log_watch {
69              
70 0     0 1 0         local $/ = "\n";
71 0         0         my @lines = <$f>;
72 0         0         undef $f;
73              
74 0         0         return @lines;
75                 }
76             }
77              
78             # because of the prototype and recursive call to itself a forward
79             # declaration is needed
80             sub t_is_equal ($$);
81              
82             # compare any two datastructures (must pass references for non-scalars)
83             # undef()'s are valid args
84             sub t_is_equal ($$) {
85 2     2 1 22     my ($a, $b) = @_;
86 2 50       25     return 0 unless @_ == 2;
87              
88             # this was added in Apache::Test::VERSION 1.12 - remove deprecated
89             # logic sometime around 1.15 or mid September, 2004.
90 2 50       31     if (UNIVERSAL::isa($a, 'Regexp')) {
91 0         0         my @warning = ("WARNING!!! t_is_equal() argument order has changed.",
92                                    "use of a regular expression as the first argument",
93                                    "is deprecated. support will be removed soon.");
94 0         0         t_debug(@warning);
95 0         0         ($a, $b) = ($b, $a);
96                 }
97              
98 2 50 33     44     if (defined $a && defined $b) {
99 2         20         my $ref_a = ref $a;
100 2         19         my $ref_b = ref $b;
101 2 50 33     30         if (!$ref_a && !$ref_b) {
    0 0        
    0 0        
    0          
102 2         64             return $a eq $b;
103                     }
104                     elsif ($ref_a eq 'ARRAY' && $ref_b eq 'ARRAY') {
105 0 0       0             return 0 unless @$a == @$b;
106 0         0             for my $i (0..$#$a) {
107 0 0       0                 t_is_equal($a->[$i], $b->[$i]) || return 0;
108                         }
109                     }
110                     elsif ($ref_a eq 'HASH' && $ref_b eq 'HASH') {
111 0 0       0             return 0 unless (keys %$a) == (keys %$b);
112 0         0             for my $key (sort keys %$a) {
113 0 0       0                 return 0 unless exists $b->{$key};
114 0 0       0                 t_is_equal($a->{$key}, $b->{$key}) || return 0;
115                         }
116                     }
117                     elsif ($ref_b eq 'Regexp') {
118 0         0             return $a =~ $b;
119                     }
120                     else {
121             # try to compare the references
122 0         0             return $a eq $b;
123                     }
124                 }
125                 else {
126             # undef == undef! a valid test
127 0 0 0     0         return (defined $a || defined $b) ? 0 : 1;
128                 }
129 0         0     return 1;
130             }
131              
132              
133              
134             sub t_cmp ($$;$) {
135 2 50 33 2 1 1395     Carp::carp(join(":", (caller)[1..2]) .
136                     ' usage: $res = t_cmp($received, $expected, [$comment])')
137                         if @_ < 2 || @_ > 3;
138              
139 2         22     my ($received, $expected) = @_;
140              
141             # this was added in Apache::Test::VERSION 1.12 - remove deprecated
142             # logic sometime around 1.15 or mid September, 2004.
143 2 50       29     if (UNIVERSAL::isa($_[0], 'Regexp')) {
144 0         0         my @warning = ("WARNING!!! t_cmp() argument order has changed.",
145                                    "use of a regular expression as the first argument",
146                                    "is deprecated. support will be removed soon.");
147 0         0         t_debug(@warning);
148 0         0         ($received, $expected) = ($expected, $received);
149                 }
150              
151 2 50       43     t_debug("testing : " . pop) if @_ == 3;
152 2         64     t_debug("expected: " . struct_as_string(0, $expected));
153 2         23     t_debug("received: " . struct_as_string(0, $received));
154 2         49     return t_is_equal($received, $expected);
155             }
156              
157             # Essentially t_cmp, but on Win32, first converts pathnames
158             # to their DOS long name.
159             sub t_filepath_cmp ($$;$) {
160 0     0 1 0     my @a = (shift, shift);
161 0         0     if (Apache::TestConfig::WIN32) {
162                     $a[0] = Win32::GetLongPathName($a[0]) if defined $a[0];
163                     $a[1] = Win32::GetLongPathName($a[1]) if defined $a[1];
164                 }
165 0 0       0     return @_ == 1 ? t_cmp($a[0], $a[1], $_[0]) : t_cmp($a[0], $a[1]);
166             }
167              
168              
169             *expand = HAS_DUMPER ?
170                 sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
171 6     6   60     sub { @_ };
172              
173             sub t_debug {
174 6     6 1 51     my $out = $Apache::TestUtil::DEBUG_OUTPUT;
175 6         59     print $out map {"# $_\n"} map {split /\n/} grep {defined} expand(@_);
  6         2526  
  6         63  
  6         59  
176             }
177              
178             sub t_open_file {
179 0     0 1 0     my $file = shift;
180              
181 0 0       0     die "must pass a filename" unless defined $file;
182              
183             # create the parent dir if it doesn't exist yet
184 0         0     makepath(dirname $file);
185              
186 0         0     my $fh = Symbol::gensym();
187 0 0       0     open $fh, ">$file" or die "can't open $file: $!";
188 0         0     t_debug("writing file: $file");
189 0         0     $CLEAN{files}{$file}++;
190              
191 0         0     return $fh;
192             }
193              
194             sub t_write_file {
195 0     0 1 0     my $file = shift;
196              
197 0 0       0     die "must pass a filename" unless defined $file;
198              
199             # create the parent dir if it doesn't exist yet
200 0         0     makepath(dirname $file);
201              
202 0         0     my $fh = Symbol::gensym();
203 0 0       0     open $fh, ">$file" or die "can't open $file: $!";
204 0         0     t_debug("writing file: $file");
205 0 0       0     print $fh join '', @_ if @_;
206 0         0     close $fh;
207 0         0     $CLEAN{files}{$file}++;
208             }
209              
210             sub t_append_file {
211 0     0 1 0     my $file = shift;
212              
213 0 0       0     die "must pass a filename" unless defined $file;
214              
215             # create the parent dir if it doesn't exist yet
216 0         0     makepath(dirname $file);
217              
218             # add to the cleanup list only if we created it now
219 0 0       0     $CLEAN{files}{$file}++ unless -e $file;
220              
221 0         0     my $fh = Symbol::gensym();
222 0 0       0     open $fh, ">>$file" or die "can't open $file: $!";
223 0 0       0     print $fh join '', @_ if @_;
224 0         0     close $fh;
225             }
226              
227             sub t_write_shell_script {
228 0     0 1 0     my $file = shift;
229              
230 0         0     my $code = join '', @_;
231 0         0     my($ext, $shebang);
232              
233 0         0     if (Apache::TestConfig::WIN32()) {
234                     $code =~ s/echo$/echo./mg; #required to echo newline
235                     $ext = 'bat';
236                     $shebang = "\@echo off\nREM this is a bat";
237                 }
238                 else {
239 0         0         $ext = 'sh';
240 0         0         $shebang = '#!/bin/sh';
241                 }
242              
243 0         0     $file .= ".$ext";
244 0         0     t_write_file($file, "$shebang\n", $code);
245 0         0     $ext;
246             }
247              
248             sub t_write_perl_script {
249 0     0 1 0     my $file = shift;
250              
251 0         0     my $shebang = "#!$Config{perlpath}\n";
252 0         0     my $warning = Apache::TestConfig->thaw->genwarning($file);
253 0         0     t_write_file($file, $shebang, $warning, @_);
254 0         0     chmod 0755, $file;
255             }
256              
257              
258             sub t_mkdir {
259 0     0 1 0     my $dir = shift;
260 0         0     makepath($dir);
261             }
262              
263             # returns a list of dirs successfully created
264             sub makepath {
265 0     0 0 0     my($path) = @_;
266              
267 0 0 0     0     return if !defined($path) || -e $path;
268 0         0     my $full_path = $path;
269              
270             # remember which dirs were created and should be cleaned up
271 0         0     while (1) {
272 0         0         $CLEAN{dirs}{$path} = 1;
273 0         0         $path = dirname $path;
274 0 0       0         last if -e $path;
275                 }
276              
277 0         0     return File::Path::mkpath($full_path, 0, 0755);
278             }
279              
280             sub t_rmtree {
281 0 0   0 1 0     die "must pass a dirname" unless defined $_[0];
282 0 0       0     File::Path::rmtree((@_ > 1 ? \@_ : $_[0]), 0, 1);
283             }
284              
285             #chown a file or directory to the test User/Group
286             #noop if chown is unsupported
287              
288             sub t_chown {
289 0     0 1 0     my $file = shift;
290 0         0     my $config = Apache::Test::config();
291 0         0     my($uid, $gid);
292              
293 0         0     eval {
294             #XXX cache this lookup
295 0         0         ($uid, $gid) = (getpwnam($config->{vars}->{user}))[2,3];
296                 };
297              
298 0 0       0     if ($@) {
299 0 0       0         if ($@ =~ /^The getpwnam function is unimplemented/) {
300             #ok if unsupported, e.g. win32
301 0         0             return 1;
302                     }
303                     else {
304 0         0             die $@;
305                     }
306                 }
307              
308 0 0       0     CORE::chown($uid, $gid, $file) || die "chown $file: $!";
309             }
310              
311             # $string = struct_as_string($indent_level, $var);
312             #
313             # return any nested datastructure via Data::Dumper or ala Data::Dumper
314             # as a string. undef() is a valid arg.
315             #
316             # $indent_level should be 0 (used for nice indentation during
317             # recursive datastructure traversal)
318             sub struct_as_string{
319 4 50   4 0 43     return "???" unless @_ == 2;
320 4         35     my $level = shift;
321              
322 4 50       38     return "undef" unless defined $_[0];
323 4         43     my $pad = ' ' x (($level + 1) * INDENT);
324 4         37     my $spad = ' ' x ($level * INDENT);
325              
326 4         32     if (HAS_DUMPER) {
327                     local $Data::Dumper::Terse = 1;
328                     $Data::Dumper::Terse = $Data::Dumper::Terse; # warn
329                     my $data = Data::Dumper::Dumper(@_);
330                     $data =~ s/\n$//; # \n is handled by the caller
331                     return $data;
332                 }
333                 else {
334 4 50       46         if (ref($_[0]) eq 'ARRAY') {
    50          
335 0         0             my @data = ();
336 0         0             for my $i (0..$#{ $_[0] }) {
  0         0  
337 0         0                 push @data,
338                                 struct_as_string($level+1, $_[0]->[$i]);
339                         }
340 0         0             return join "\n", "[", map({"$pad$_,"} @data), "$spad\]";
  0         0  
341                     } elsif ( ref($_[0])eq 'HASH') {
342 0         0             my @data = ();
343 0         0             for my $key (keys %{ $_[0] }) {
  0         0  
344 0         0                 push @data,
345                                 "$key => " .
346                                 struct_as_string($level+1, $_[0]->{$key});
347                         }
348 0         0             return join "\n", "{", map({"$pad$_,"} @data), "$spad\}";
  0         0  
349                     } else {
350 4         48             return $_[0];
351                     }
352                 }
353             }
354              
355             my $banner_format =
356                 "\n*** The following %s expected and harmless ***\n";
357              
358             sub is_expected_banner {
359 0     0 0       my $type = shift;
360 0 0             my $count = @_ ? shift : 1;
361 0 0             sprintf $banner_format, $count == 1
362                     ? "$type entry is"
363                     : "$count $type entries are";
364             }
365              
366             sub t_server_log_is_expected {
367 0     0 0       print STDERR is_expected_banner(@_);
368             }
369              
370             sub t_client_log_is_expected {
371 0     0 0       my $vars = Apache::Test::config()->{vars};
372 0               my $log_file = catfile $vars->{serverroot}, "logs", "error_log";
373              
374 0               my $fh = Symbol::gensym();
375 0 0             open $fh, ">>$log_file" or die "Can't open $log_file: $!";
376 0               my $oldfh = select($fh); $| = 1; select($oldfh);
  0            
  0            
377 0               print $fh is_expected_banner(@_);
378 0               close $fh;
379             }
380              
381 0     0 1   sub t_server_log_error_is_expected { t_server_log_is_expected("error", @_);}
382 0     0 1   sub t_server_log_warn_is_expected { t_server_log_is_expected("warn", @_); }
383 0     0 1   sub t_client_log_error_is_expected { t_client_log_is_expected("error", @_);}
384 0     0 1   sub t_client_log_warn_is_expected { t_client_log_is_expected("warn", @_); }
385              
386             END {
387             # remove files that were created via this package
388                 for (grep {-e $_ && -f _ } keys %{ $CLEAN{files} } ) {
389                     t_debug("removing file: $_");
390                     unlink $_;
391                 }
392              
393             # remove dirs that were created via this package
394                 for (grep {-e $_ && -d _ } keys %{ $CLEAN{dirs} } ) {
395                     t_debug("removing dir tree: $_");
396                     t_rmtree($_);
397                 }
398             }
399              
400             # essentially File::Spec->catfile, but on Win32
401             # returns the long path name, if the file is absolute
402             sub t_catfile {
403 0     0 1       my $f = catfile(@_);
404 0 0             return $f unless file_name_is_absolute($f);
405 0               return Apache::TestConfig::WIN32 ?
406                     Win32::GetLongPathName($f) : $f;
407             }
408              
409             # Apache uses a Unix-style specification for files, with
410             # forward slashes for directory separators. This is
411             # essentially File::Spec::Unix->catfile, but on Win32
412             # returns the long path name, if the file is absolute
413             sub t_catfile_apache {
414 0     0 1       my $f = File::Spec::Unix->catfile(@_);
415 0 0             return $f unless file_name_is_absolute($f);
416 0               return Apache::TestConfig::WIN32 ?
417                     Win32::GetLongPathName($f) : $f;
418             }
419              
420             1;
421             __END__
422            
423            
424             =head1 NAME
425            
426             Apache::TestUtil - Utility functions for writing tests
427            
428             =head1 SYNOPSIS
429            
430             use Apache::Test;
431             use Apache::TestUtil;
432            
433             ok t_cmp("foo", "foo", "sanity check");
434             t_write_file("filename", @content);
435             my $fh = t_open_file($filename);
436             t_mkdir("/foo/bar");
437             t_rmtree("/foo/bar");
438             t_is_equal($a, $b);
439            
440             =head1 DESCRIPTION
441            
442             C<Apache::TestUtil> automatically exports a number of functions useful
443             in writing tests.
444            
445             All the files and directories created using the functions from this
446             package will be automatically destroyed at the end of the program
447             execution (via END block). You should not use these functions other
448             than from within tests which should cleanup all the created
449             directories and files at the end of the test.
450            
451             =head1 FUNCTIONS
452            
453             =over
454            
455             =item t_cmp()
456            
457             t_cmp($received, $expected, $comment);
458            
459             t_cmp() prints the values of I<$comment>, I<$expected> and
460             I<$received>. e.g.:
461            
462             t_cmp(1, 1, "1 == 1?");
463            
464             prints:
465            
466             # testing : 1 == 1?
467             # expected: 1
468             # received: 1
469            
470             then it returns the result of comparison of the I<$expected> and the
471             I<$received> variables. Usually, the return value of this function is
472             fed directly to the ok() function, like this:
473            
474             ok t_cmp(1, 1, "1 == 1?");
475            
476             the third argument (I<$comment>) is optional, mostly useful for
477             telling what the comparison is trying to do.
478            
479             It is valid to use C<undef> as an expected value. Therefore:
480            
481             my $foo;
482             t_cmp(undef, $foo, "undef == undef?");
483            
484             will return a I<true> value.
485            
486             You can compare any two data-structures with t_cmp(). Just make sure
487             that if you pass non-scalars, you have to pass their references. The
488             datastructures can be deeply nested. For example you can compare:
489            
490             t_cmp({1 => [2..3,{5..8}], 4 => [5..6]},
491             {1 => [2..3,{5..8}], 4 => [5..6]},
492             "hash of array of hashes");
493            
494             You can also compare the second argument against the first as a
495             regex. Use the C<qr//> function in the second argument. For example:
496            
497             t_cmp("abcd", qr/^abc/, "regex compare");
498            
499             will do:
500            
501             "abcd" =~ /^abc/;
502            
503             This function is exported by default.
504            
505             =item t_filepath_cmp()
506            
507             This function is used to compare two filepaths via t_cmp().
508             For non-Win32, it simply uses t_cmp() for the comparison,
509             but for Win32, Win32::GetLongPathName() is invoked to convert
510             the first two arguments to their DOS long pathname. This is useful
511             when there is a possibility the two paths being compared
512             are not both represented by their long or short pathname.
513            
514             This function is exported by default.
515            
516             =item t_debug()
517            
518             t_debug("testing feature foo");
519             t_debug("test", [1..3], 5, {a=>[1..5]});
520            
521             t_debug() prints out any datastructure while prepending C<#> at the
522             beginning of each line, to make the debug printouts comply with
523             C<Test::Harness>'s requirements. This function should be always used
524             for debug prints, since if in the future the debug printing will
525             change (e.g. redirected into a file) your tests won't need to be
526             changed.
527            
528             the special global variable $Apache::TestUtil::DEBUG_OUTPUT can
529             be used to redirect the output from t_debug() and related calls
530             such as t_write_file(). for example, from a server-side test
531             you would probably need to redirect it to STDERR:
532            
533             sub handler {
534             plan $r, tests => 1;
535            
536             local $Apache::TestUtil::DEBUG_OUTPUT = \*STDERR;
537            
538             t_write_file('/tmp/foo', 'bar');
539             ...
540             }
541            
542             left to its own devices, t_debug() will collide with the standard
543             HTTP protocol during server-side tests, resulting in a situation
544             both confusing difficult to debug. but STDOUT is left as the
545             default, since you probably don't want debug output under normal
546             circumstances unless running under verbose mode.
547            
548             This function is exported by default.
549            
550             =item t_write_file()
551            
552             t_write_file($filename, @lines);
553            
554             t_write_file() creates a new file at I<$filename> or overwrites the
555             existing file with the content passed in I<@lines>. If only the
556             I<$filename> is passed, an empty file will be created.
557            
558             If parent directories of C<$filename> don't exist they will be
559             automagically created.
560            
561             The generated file will be automatically deleted at the end of the
562             program's execution.
563            
564             This function is exported by default.
565            
566             =item t_append_file()
567            
568             t_append_file($filename, @lines);
569            
570             t_append_file() is similar to t_write_file(), but it doesn't clobber
571             existing files and appends C<@lines> to the end of the file. If the
572             file doesn't exist it will create it.
573            
574             If parent directories of C<$filename> don't exist they will be
575             automagically created.
576            
577             The generated file will be registered to be automatically deleted at
578             the end of the program's execution, only if the file was created by
579             t_append_file().
580            
581             This function is exported by default.
582            
583             =item t_write_shell_script()
584            
585             Apache::TestUtil::t_write_shell_script($filename, @lines);
586            
587             Similar to t_write_file() but creates a portable shell/batch
588             script. The created filename is constructed from C<$filename> and an
589             appropriate extension automatically selected according to the platform
590             the code is running under.
591            
592             It returns the extension of the created file.
593            
594             =item t_write_perl_script()
595            
596             Apache::TestUtil::t_write_perl_script($filename, @lines);
597            
598             Similar to t_write_file() but creates a executable Perl script with
599             correctly set shebang line.
600            
601             =item t_open_file()
602            
603             my $fh = t_open_file($filename);
604            
605             t_open_file() opens a file I<$filename> for writing and returns the
606             file handle to the opened file.
607            
608             If parent directories of C<$filename> don't exist they will be
609             automagically created.
610            
611             The generated file will be automatically deleted at the end of the
612             program's execution.
613            
614             This function is exported by default.
615            
616             =item t_mkdir()
617            
618             t_mkdir($dirname);
619            
620             t_mkdir() creates a directory I<$dirname>. The operation will fail if
621             the parent directory doesn't exist.
622            
623             If parent directories of C<$dirname> don't exist they will be
624             automagically created.
625            
626             The generated directory will be automatically deleted at the end of
627             the program's execution.
628            
629             This function is exported by default.
630            
631             =item t_rmtree()
632            
633             t_rmtree(@dirs);
634            
635             t_rmtree() deletes the whole directories trees passed in I<@dirs>.
636            
637             This function is exported by default.
638            
639             =item t_chown()
640            
641             Apache::TestUtil::t_chown($file);
642            
643             Change ownership of $file to the test's I<User>/I<Group>. This
644             function is noop on platforms where chown(2) is unsupported
645             (e.g. Win32).
646            
647             =item t_is_equal()
648            
649             t_is_equal($a, $b);
650            
651             t_is_equal() compares any two datastructures and returns 1 if they are
652             exactly the same, otherwise 0. The datastructures can be nested
653             hashes, arrays, scalars, undefs or a combination of any of these. See
654             t_cmp() for an example.
655            
656             If C<$b> is a regex reference, the regex comparison C<$a =~ $b> is
657             performed. For example:
658            
659             t_is_equal($server_version, qr{^Apache});
660            
661             If comparing non-scalars make sure to pass the references to the
662             datastructures.
663            
664             This function is exported by default.
665            
666             =item t_server_log_error_is_expected()
667            
668             If the handler's execution results in an error or a warning logged to
669             the I<error_log> file which is expected, it's a good idea to have a
670             disclaimer printed before the error itself, so one can tell real
671             problems with tests from expected errors. For example when testing how
672             the package behaves under error conditions the I<error_log> file might
673             be loaded with errors, most of which are expected.
674            
675             For example if a handler is about to generate a run-time error, this
676             function can be used as:
677            
678             use Apache::TestUtil;
679             ...
680             sub handler {
681             my $r = shift;
682             ...
683             t_server_log_error_is_expected();
684             die "failed because ...";
685             }
686            
687             After running this handler the I<error_log> file will include:
688            
689             *** The following error entry is expected and harmless ***
690             [Tue Apr 01 14:00:21 2003] [error] failed because ...
691            
692             When more than one entry is expected, an optional numerical argument,
693             indicating how many entries to expect, can be passed. For example:
694            
695             t_server_log_error_is_expected(2);
696            
697             will generate:
698            
699             *** The following 2 error entries are expected and harmless ***
700            
701             If the error is generated at compile time, the logging must be done in
702             the BEGIN block at the very beginning of the file:
703            
704             BEGIN {
705             use Apache::TestUtil;
706             t_server_log_error_is_expected();
707             }
708             use DOES_NOT_exist;
709            
710             After attempting to run this handler the I<error_log> file will
711             include:
712            
713             *** The following error entry is expected and harmless ***
714             [Tue Apr 01 14:04:49 2003] [error] Can't locate "DOES_NOT_exist.pm"
715             in @INC (@INC contains: ...
716            
717             Also see C<t_server_log_warn_is_expected()> which is similar but used
718             for warnings.
719            
720             This function is exported by default.
721            
722             =item t_server_log_warn_is_expected()
723            
724             C<t_server_log_warn_is_expected()> generates a disclaimer for expected
725             warnings.
726            
727             See the explanation for C<t_server_log_error_is_expected()> for more
728             details.
729            
730             This function is exported by default.
731            
732             =item t_client_log_error_is_expected()
733            
734             C<t_client_log_error_is_expected()> generates a disclaimer for
735             expected errors. But in contrast to
736             C<t_server_log_error_is_expected()> called by the client side of the
737             script.
738            
739             See the explanation for C<t_server_log_error_is_expected()> for more
740             details.
741            
742             For example the following client script fails to find the handler:
743            
744             use Apache::Test;
745             use Apache::TestUtil;
746             use Apache::TestRequest qw(GET);
747            
748             plan tests => 1;
749            
750             t_client_log_error_is_expected();
751             my $url = "/error_document/cannot_be_found";
752             my $res = GET($url);
753             ok t_cmp(404, $res->code, "test 404");
754            
755             After running this test the I<error_log> file will include an entry
756             similar to the following snippet:
757            
758             *** The following error entry is expected and harmless ***
759             [Tue Apr 01 14:02:55 2003] [error] [client 127.0.0.1]
760             File does not exist: /tmp/test/t/htdocs/error
761            
762             When more than one entry is expected, an optional numerical argument,
763             indicating how many entries to expect, can be passed. For example:
764            
765             t_client_log_error_is_expected(2);
766            
767             will generate:
768            
769             *** The following 2 error entries are expected and harmless ***
770            
771             This function is exported by default.
772            
773             =item t_client_log_warn_is_expected()
774            
775             C<t_client_log_warn_is_expected()> generates a disclaimer for expected
776             warnings on the client side.
777            
778             See the explanation for C<t_client_log_error_is_expected()> for more
779             details.
780            
781             This function is exported by default.
782            
783             =item t_catfile('a', 'b', 'c')
784            
785             This function is essentially C<File::Spec-E<gt>catfile>, but
786             on Win32 will use C<Win32::GetLongpathName()> to convert the
787             result to a long path name (if the result is an absolute file).
788             The function is not exported by default.
789            
790             =item t_catfile_apache('a', 'b', 'c')
791            
792             This function is essentially C<File::Spec::Unix-E<gt>catfile>, but
793             on Win32 will use C<Win32::GetLongpathName()> to convert the
794             result to a long path name (if the result is an absolute file).
795             It is useful when comparing something to that returned by Apache,
796             which uses a Unix-style specification with forward slashes for
797             directory separators. The function is not exported by default.
798            
799             =item t_start_error_log_watch(), t_finish_error_log_watch()
800            
801             This pair of functions provides an easy interface for checking
802             the presence or absense of any particular message or messages
803             in the httpd error_log that were generated by the httpd daemon
804             as part of a test suite. It is likely, that you should proceed
805             this with a call to one of the t_*_is_expected() functions.
806            
807             t_start_error_log_watch();
808             do_it;
809             ok grep {...} t_finish_error_log_watch()
810            
811             =back
812            
813             =head1 AUTHOR
814            
815             Stas Bekman <stas@stason.org>
816            
817             =head1 SEE ALSO
818            
819             perl(1)
820            
821             =cut
822            
823