perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/response/TestVhost log.pm
Date Thu, 16 Sep 2004 23:01:13 GMT
stas        2004/09/16 16:01:13

  Modified:    t/response/TestVhost log.pm
  Added:       t/lib/TestCommon LogDiff.pm
  Log:
  abstract the log file incremental diff functionality into a module, so it
  can be used by other tests
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/lib/TestCommon/LogDiff.pm
  
  Index: LogDiff.pm
  ===================================================================
  package TestCommon::LogDiff;
  
  use POSIX ();
  
  sub new {
      my $class = shift;
      my $path  = shift;
  
      open my $fh, "<$path" or die "Can't open $path: $!";
      seek $fh, 0, POSIX::SEEK_END();
      $pos = tell $fh;
  
      my %self = (
          path => $path,
          fh   => $fh,
          pos  => $pos,
      );
  
      return bless \%self, $class;
  }
  
  sub DESTROY {
      my $self = shift;
      close $self->{fh};
  }
  
  sub diff {
      my $self = shift;
  
      # XXX: is it possible that some system will be slow to flush the
      # buffers and we may need to wait a bit and retry if we see no new
      # logged data?
      my $fh = $self->{fh};
      seek $fh, $self->{pos}, POSIX::SEEK_SET(); # not really needed
  
      local $/; # slurp mode
      my $diff = <$fh>;
      seek $fh, 0, POSIX::SEEK_END();
      $self->{pos} = tell $fh;
  
      return defined $diff ? $diff : '';
  }
  
  1;
  
  __END__
  
  =head1 NAME
  
  TestCommon::LogDiff - get log file diffs
  
  =head1 Synopsis
  
    use TestCommon::LogDiff;
    use Test;
    
    plan tests => 2;
    
    my $path = "/tmp/mylog";
    open my $fh, ">>$path" or die "Can't open $path: $!";
    
    my $logdiff = TestCommon::LogDiff->new($path);
    
    print $fh "foo 123\n";
    my $expected = qr/^foo/;
    ok t_cmp $logdiff->diff, $expected;
    
    print $fh "bar\n";
    my $expected = 'bar';
    ok t_cmp $logdiff->diff, $expected;
  
  
  =head1 Description
  
  Useful for testing the warning, error and other messages going into
  the log file.
  
  =head1 API
  
  =head2 new
  
  open the log file and point the filehandle pointer to its end.
  
  =head2 diff
  
  extract any newly logged information since the last check and move the
  filehandle to the end of the file.
  
  =cut
  
  
  
  
  1.5       +9 -36     modperl-2.0/t/response/TestVhost/log.pm
  
  Index: log.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestVhost/log.pm,v
  retrieving revision 1.4
  retrieving revision 1.5
  diff -u -u -r1.4 -r1.5
  --- log.pm	16 Sep 2004 16:36:29 -0000	1.4
  +++ log.pm	16 Sep 2004 23:01:13 -0000	1.5
  @@ -11,11 +11,10 @@
   use Apache::ServerRec qw(warn); # override warn locally
   
   use File::Spec::Functions qw(catfile);
  -use POSIX ();
  -use Symbol ();
   
   use Apache::Test;
   use Apache::TestUtil;
  +use TestCommon::LogDiff;
   
   use Apache::Const -compile => 'OK';
   
  @@ -35,8 +34,6 @@
   
   my $path = catfile Apache::Test::vars('documentroot'),
       qw(vhost error_log);
  -my $fh;
  -my $pos;
   
   sub handler {
       my $r = shift;
  @@ -44,16 +41,12 @@
       plan $r, tests => 1 + @methods1 + @methods2;
   
       my $s = $r->server;
  -
  -    $fh = Symbol::gensym();
  -    open $fh, "<$path" or die "Can't open $path: $!";
  -    seek $fh, 0, POSIX::SEEK_END();
  -    $pos = tell $fh;
  +    my $logdiff = TestCommon::LogDiff->new($path);
   
       ### $r|$s logging
       for my $m (@methods1) {
           eval "$m(q[$m])";
  -        check($m);
  +        ok t_cmp $logdiff->diff, qr/\Q$m/, $m;
       }
   
       ### object-less logging
  @@ -64,45 +57,25 @@
       Apache->request($r);
       for my $m (@methods2) {
           eval "$m(q[$m])";
  -        check($m);
  +        ok t_cmp $logdiff->diff, qr/\Q$m/, $m;
       }
   
       # internal warnings (also needs +GlobalRequest)
       {
           no warnings; # avoid FATAL warnings
           use warnings;
  -        local $SIG{__WARN__}= \&Apache::ServerRec::warn;
  +        local $SIG{__WARN__} = \&Apache::ServerRec::warn;
           eval q[my $x = "aaa" + 1;];
  -        check(q[Argument "aaa" isn't numeric in addition])
  +        ok t_cmp
  +            $logdiff->diff,
  +            qr/Argument "aaa" isn't numeric in addition/,
  +            "internal warning";
       }
   
       # die logs into the vhost log just fine
       #die "horrible death!";
   
  -    close $fh;
  -
       Apache::OK;
  -}
  -
  -sub check {
  -    my $find = shift;
  -    $find = ref $find eq 'Regexp' ? $find : qr/\Q$find/;
  -    my $diff = diff();
  -    ok t_cmp $diff, $find;
  -}
  -
  -# extract any new logged information since the last check, move the
  -# filehandle to the end of the file
  -sub diff {
  -    # XXX: is it possible that some system will be slow to flush the
  -    # buffers and we may need to wait a bit and retry if we get see
  -    # no new logged data?
  -    seek $fh, $pos, POSIX::SEEK_SET(); # not really needed
  -    local $/; # slurp mode
  -    my $diff = <$fh>;
  -    seek $fh, 0, POSIX::SEEK_END();
  -    $pos = tell $fh;
  -    return defined $diff ? $diff : '';
   }
   
   1;
  
  
  

Mime
View raw message