[prev in list] [next in list] [prev in thread] [next in thread] 

List:       apache-test-cvs
Subject:    cvs commit: httpd-test/perl-framework/Apache-Test Changes
From:       stas () apache ! org
Date:       2003-05-14 2:03:40
[Download RAW message or body]

stas        2003/05/13 19:03:40

  Modified:    perl-framework/Apache-Test/lib/Apache TestTrace.pm
               perl-framework/Apache-Test Changes
  Log:
  add two more variants of each of the tracing functions. If the '_mark'
  suffix is appended (e.g., 'error_mark') the trace will start with the
  filename and the line number the function was called from. If the
  '_sub' suffix is appended (e.g., 'error_info') the trace will start
  with the name of the subroutine the function was called from.
  
  Revision  Changes    Path
  1.15      +44 -12    httpd-test/perl-framework/Apache-Test/lib/Apache/TestTrace.pm
  
  Index: TestTrace.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestTrace.pm,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- TestTrace.pm	14 May 2003 01:12:22 -0000	1.14
  +++ TestTrace.pm	14 May 2003 02:03:40 -0000	1.15
  @@ -6,17 +6,18 @@
   use Apache::TestConfig ();
   
   use Exporter ();
  -use vars qw(@Levels @Utils @ISA @EXPORT $VERSION $Level $LogFH);
  +use vars qw(@Levels @Utils @Subs @ISA @EXPORT $VERSION $Level $LogFH);
   
   BEGIN {
       @Levels = qw(emerg alert crit error warning notice info debug);
       @Utils  = qw(todo);
  +    @Subs   = map {($_, "${_}_mark", "${_}_sub")} (@Levels, @Utils);
   }
   
   @ISA     = qw(Exporter);
  -@EXPORT  = (@Levels, @Utils);
  +@EXPORT  = (@Subs);
   $VERSION = '0.01';
  -use subs (@Levels, @Utils);
  +use subs (@Subs);
   
   # default settings overrideable by users
   $Level = undef;
  @@ -75,30 +76,49 @@
       sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
       sub { @_ };
   
  +sub prefix {
  +    my $prefix = shift;
  +
  +    if ($prefix eq 'mark') {
  +        return join(":", (caller(3))[1..2]) . " : ";
  +    }
  +    elsif ($prefix eq 'sub') {
  +        return (caller(3))[3] . " : ";
  +    }
  +    else {
  +        return '';
  +    }
  +}
  +
   sub c_trace {
  -    my $level = shift;
  +    my ($level, $prefix_type) = (shift, shift);
  +    my $prefix = prefix($prefix_type);
       print $LogFH 
  -        map { "$colors{$level}$_$colors{reset}\n"}
  +        map { "$colors{$level}$prefix$_$colors{reset}\n"}
           grep defined($_), expand(@_);
   }
   
   sub nc_trace {
  -    my $level = shift;
  +    my ($level, $prefix_type) = (shift, shift);
  +    my $prefix = prefix($prefix_type);
       print $LogFH 
  -        map { sprintf "%-3s %s\n", $colors{$level}, $_ } 
  +        map { sprintf "%-3s %s%s\n", $colors{$level}, $prefix, $_ } 
           grep defined($_), expand(@_);
   }
   
   {
       my $trace = HAS_COLOR ? \&c_trace : \&nc_trace;
  -
  +    my @prefices = ('', 'mark', 'sub');
       # if the level is sufficiently high, enable the tracing for a
       # given level otherwise assign NOP
  -    for my $level (@Levels,@Utils) {
  +    for my $level (@Levels, @Utils) {
           no strict 'refs';
  -        *$level = sub { 
  -            $trace->($level, @_) if trace_level() >= $levels{$level};
  -        };
  +        for my $prefix (@prefices) {
  +            my $func = $prefix ? "${level}_$prefix" : $level;
  +            *$func = sub { $trace->($level, $prefix, @_)
  +                               if trace_level() >= $levels{$level};
  +                     };
  +        }
       }
   }
   
  @@ -123,6 +143,12 @@
   
       use Apache::TestTrace;
     
  +    debug "foo bar";
  +  
  +    info_sub "missed it";
  +  
  +    error_mark "something is wrong";
  +
       # test sub that exercises all the tracing functions
       sub test {
           print $Apache::TestTrace::LogFH 
  @@ -179,6 +205,12 @@
   The module provides another trace function called todo() which is
   useful for todo items. It has the same level as I<debug> (the
   highest).
  +
  +There are two more variants of each of these functions. If the
  +I<_mark> suffix is appended (e.g., I<error_mark>) the trace will start
  +with the filename and the line number the function was called from. If
  +the I<_sub> suffix is appended (e.g., I<error_info>) the trace will
  +start with the name of the subroutine the function was called from.
   
   If you have C<Term::ANSIColor> installed the diagnostic messages will
   be colorized, otherwise a special for each function prefix will be
  
  
  
  1.19      +12 -0     httpd-test/perl-framework/Apache-Test/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/Changes,v
  retrieving revision 1.18
  retrieving revision 1.19
  diff -u -r1.18 -r1.19
  --- Changes	3 May 2003 03:15:12 -0000	1.18
  +++ Changes	14 May 2003 02:03:40 -0000	1.19
  @@ -8,6 +8,18 @@
   
   =item 1.03-dev - 
   
  +add two more variants of each of the tracing functions. If the '_mark'
  +suffix is appended (e.g., 'error_mark') the trace will start with the
  +filename and the line number the function was called from. If the
  +'_sub' suffix is appended (e.g., 'error_info') the trace will start
  +with the name of the subroutine the function was called from. [Stas]
  +
  +introduce a new env var APACHE_TEST_TRACE_LEVEL, to override the trace
  +level. Propogate the overriden values (either by env var
  +APACHE_TEST_TRACE_LEVEL or -trace option) to the server-side, so we
  +can use tracing in the handlers, and enable disable traces from the
  +commmand line. This way we don't have to comment out debug
  +tracing. [Stas]
   
   =item 1.02
   
  
  
  
[prev in list] [next in list] [prev in thread] [next in thread]