perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Fred Moyer <f...@redhotpenguin.com>
Subject Re: adding t_{start,read,finish}_file_watch to Apache::TestUtil
Date Thu, 08 Apr 2010 19:14:32 GMT
+1

2010/4/8 Torsten Förtsch <torsten.foertsch@gmx.net>:
> Sometimes I miss these functions and then I write them each time again.
>
> Index: Apache-Test/t/log_watch.t
> ===================================================================
> --- Apache-Test/t/log_watch.t   (revision 0)
> +++ Apache-Test/t/log_watch.t   (revision 0)
> @@ -0,0 +1,73 @@
> +use strict;
> +use warnings FATAL => 'all';
> +
> +use Apache::Test;
> +use Apache::TestUtil qw/t_start_file_watch
> +                        t_read_file_watch
> +                        t_finish_file_watch
> +                        t_write_file
> +                        t_append_file
> +                        t_catfile
> +                        t_cmp/;
> +
> +plan tests => 11;
> +
> +my $fn=t_catfile(Apache::Test::vars->{t_logs}, 'watch');
> +unlink $fn;
> +
> +t_start_file_watch 'watch';
> +
> +t_write_file $fn, "1\n2\n";
> +
> +ok t_cmp [t_read_file_watch 'watch'], ["1\n", "2\n"],
> +    "t_read_file_watch on previously non-existing file";
> +
> +t_append_file $fn, "3\n4\n";
> +
> +ok t_cmp [t_read_file_watch 'watch'], ["3\n", "4\n"],
> +    "subsequent t_read_file_watch";
> +
> +t_append_file $fn, "5\n6\n";
> +
> +ok t_cmp [t_finish_file_watch 'watch'], ["5\n", "6\n"],
> +    "subsequent t_finish_file_watch";
> +
> +ok t_cmp [t_finish_file_watch 'watch'],
> ["1\n","2\n","3\n","4\n","5\n","6\n"],
> +    "t_finish_file_watch w/o start";
> +
> +ok t_cmp [t_read_file_watch 'watch'], ["1\n","2\n","3\n","4\n","5\n","6\n"],
> +    "t_read_file_watch w/o start";
> +
> +ok t_cmp [t_read_file_watch 'watch'], [],
> +    "subsequent t_read_file_watch";
> +
> +t_append_file $fn, "7\n8\n";
> +unlink $fn;
> +
> +ok t_cmp [t_read_file_watch 'watch'], ["7\n","8\n"],
> +    "subsequent t_read_file_watch file unlinked";
> +
> +t_write_file $fn, "1\n2\n3\n4\n5\n6\n7\n8\n";
> +
> +ok t_cmp [t_finish_file_watch 'watch'], [],
> +    "subsequent t_finish_file_watch - new file exists but fh is cached";
> +
> +t_start_file_watch 'watch';
> +
> +ok t_cmp [t_read_file_watch 'watch'], [],
> +    "t_read_file_watch at EOF";
> +
> +unlink $fn;
> +t_start_file_watch 'watch';
> +
> +t_write_file $fn, "1\n2\n3\n4\n5\n6\n7\n8\n";
> +
> +{
> +    local $/=\4;
> +
> +    ok t_cmp [scalar t_read_file_watch 'watch'], ["1\n2\n"],
> +        "t_read_file_watch fixed record length / scalar context";
> +
> +    ok t_cmp [t_finish_file_watch 'watch'], ["3\n4\n","5\n6\n","7\n8\n"],
> +        "t_finish_file_watch fixed record length";
> +}
> Index: Apache-Test/lib/Apache/TestUtil.pm
> ===================================================================
> --- Apache-Test/lib/Apache/TestUtil.pm  (revision 931462)
> +++ Apache-Test/lib/Apache/TestUtil.pm  (working copy)
> @@ -43,8 +43,9 @@
>  );
>
>  @EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown
> -               t_catfile_apache t_catfile
> -               t_start_error_log_watch t_finish_error_log_watch);
> +                t_catfile_apache t_catfile
> +                t_start_error_log_watch t_finish_error_log_watch
> +                t_start_file_watch t_read_file_watch t_finish_file_watch);
>
>  %CLEAN = ();
>
> @@ -55,24 +56,59 @@
>  use constant INDENT     => 4;
>
>  {
> -    my $f;
> -    sub t_start_error_log_watch {
> +    my %files;
> +    sub t_start_file_watch (;$) {
> +        my $name = @_ ? $_[0] : 'error_log';
> +        $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
> +            unless (File::Spec->file_name_is_absolute($name));
>
> -        my $name = File::Spec->catfile(Apache::Test::vars->{t_logs},
> 'error_log');
> -        open $f, "$name" or die "ERROR: Cannot open $name: $!\n";
> -        seek $f, 0, SEEK_END;
> +        if (open my $fh, '<', $name) {
> +            seek $fh, 0, SEEK_END;
> +            $files{$name} = $fh;
> +        }
> +        else {
> +            delete $files{$name};
> +        }
>
>         return;
>     }
>
> -    sub t_finish_error_log_watch {
> +    sub t_finish_file_watch (;$) {
> +        my $name = @_ ? $_[0] : 'error_log';
> +        $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
> +            unless (File::Spec->file_name_is_absolute($name));
>
> -        local $/ = "\n";
> -        my @lines = <$f>;
> -        undef $f;
> +        my $fh = delete $files{$name};
> +        unless (defined $fh) {
> +            open $fh, '<', $name or return;
> +            return readline $fh;
> +        }
>
> -        return @lines;
> +        return readline $fh;
> +     }
> +
> +    sub t_read_file_watch (;$) {
> +        my $name = @_ ? $_[0] : 'error_log';
> +        $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
> +            unless (File::Spec->file_name_is_absolute($name));
> +
> +        my $fh = $files{$name};
> +        unless (defined $fh) {
> +            open $fh, '<', $name or return;
> +            $files{$name} = $fh;
> +        }
> +
> +        return readline $fh;
>     }
> +
> +    sub t_start_error_log_watch {
> +        t_start_file_watch undef;
> +    }
> +
> +    sub t_finish_error_log_watch {
> +        local $/ = "\n";
> +        return my @lines = t_finish_file_watch;
> +    }
>  }
>
>  # because of the prototype and recursive call to itself a forward
> @@ -432,6 +468,7 @@
>  1;
>  __END__
>
> +=encoding utf8
>
>  =head1 NAME
>
> @@ -829,13 +866,63 @@
>
>   t_start_error_log_watch();
>   do_it;
> -  ok grep {...} t_finish_error_log_watch()
> +  ok grep {...} t_finish_error_log_watch();
>
> +Another usage case could be a handler that emits some debugging messages
> +to the error_log. Now, if this handler is called in a series of other
> +test cases it can be hard to find the relevant messages manually. In such
> +cases the following sequence in the test file may help:
> +
> +  t_start_error_log_watch();
> +  GET '/this/or/that';
> +  t_debug t_finish_error_log_watch();
> +
> +=item t_start_file_watch()
> +
> +  Apache::TestUtil::t_start_file_watch('access_log');
> +
> +This function is similar to C<t_start_error_log_watch()> but allows for
> +other files than C<error_log> to be watched. It opens the given file
> +and positions the file pointer at its end. Subsequent calls to
> +C<t_read_file_watch()> or C<t_finish_file_watch()> will read lines that
> +have been appended after this call.
> +
> +A file name can be passed as parameter. If omitted
> +or undefined the C<error_log> is opened. Relative file name are
> +evaluated relative to the directory containing C<error_log>.
> +
> +If the specified file does not exist (yet) no error is returned. It is
> +assumed that it will appear soon. In this case
> C<t_{read,finish}_file_watch()>
> +will open the file silently and read from the beginning.
> +
> +=item t_read_file_watch(), t_finish_file_watch()
> +
> +  local $/ = "\n";
> +  $line1=Apache::TestUtil::t_read_file_watch('access_log');
> +  $line2=Apache::TestUtil::t_read_file_watch('access_log');
> +
> +  @lines=Apache::TestUtil::t_finish_file_watch('access_log');
> +
> +This pair of functions reads the file opened by C<t_start_error_log_watch()>.
> +
> +As does the core C<readline> function, they return one line if called in
> +scalar context, otherwise all lines until end of file.
> +
> +Before calling C<readline> these functions do not set C<$/> as does
> +C<t_finish_error_log_watch>. So, if the file has for example a fixed
> +record length use this:
> +
> +  {
> +    local $/=\$record_length;
> +    @lines=t_finish_file_watch($name);
> +  }
> +
>  =back
>
>  =head1 AUTHOR
>
> -Stas Bekman <stas@stason.org>
> +Stas Bekman <stas@stason.org>,
> +Torsten Förtsch <torsten.foertsch@gmx.net>
>
>  =head1 SEE ALSO
>
>
>
> Torsten Förtsch
>
> --
> Need professional modperl support? Hire me! (http://foertsch.name)
>
> Like fantasy? http://kabatinte.net
>
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
>

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message