perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From sbek...@apache.org
Subject cvs commit: modperl-2.0/Apache-Test MANIFEST
Date Thu, 21 Jun 2001 07:40:09 GMT
sbekman     01/06/21 00:40:09

  Modified:    Apache-Test MANIFEST
  Added:       Apache-Test/lib/Apache TestTrace.pm
  Log:
  a new test tracing module: see the pod section for more info
  
  Revision  Changes    Path
  1.1                  modperl-2.0/Apache-Test/lib/Apache/TestTrace.pm
  
  Index: TestTrace.pm
  ===================================================================
  package Apache::TestTrace;
  
  use strict;
  
  use Exporter ();
  our (@Levels, @Utils);
  
  BEGIN {
      @Levels = qw(emerg alert crit error warning notice info debug);
      @Utils  = qw(todo);
  }
  
  our @ISA     = qw(Exporter);
  our @EXPORT  = (@Levels, @Utils);
  our $VERSION = '0.01';
  use subs (@Levels,@Utils);
  
  # default settings overrideable by users
  our $Level = 'warning';
  our $LogFH = \*STDERR;
  
  # private data
  use constant HAS_COLOR  => eval { require Term::ANSIColor; };
  use constant HAS_DUMPER => eval { require Data::Dumper;    };
  
  # emerg => 1, alert => 2, crit => 3, ...
  my %levels; @levels{@Levels} = 1..@Levels;
  $levels{todo} = $levels{debug};
  my $default_level = 'warning'; # to prevent user typos
  
  my %colors = ();
  
  if (HAS_COLOR) {
      $Term::ANSIColor::AUTORESET = 1;
      %colors = (emerg   => 'bold white on_blue',
                 alert   => 'bold blue on_yellow',
                 crit    => 'reverse',
                 error   => 'bold red',
                 warning => 'yellow',
                 notice  => 'reset',
                 info    => 'blue',
                 debug   => 'green',
                 reset   => 'reset',
                 todo    => 'underline',
                );
      $colors{$_} = Term::ANSIColor::color($colors{$_}) for keys %colors;
  } else {
      %colors = (
                 emerg   => '&&&',
                 alert   => '$$$',
                 crit    => '%%%',
                 error   => '!!!',
                 warning => '***',
                 notice  => '---',
                 info    => '___',
                 debug   => '==>',
                 todo    => 'todo',
                );
  }
  
  *expand = HAS_DUMPER ?
      sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
      sub { @_ };
  
  sub c_trace {
      my $level = shift;
      print $LogFH 
          map { "$colors{$level}$_$colors{reset}\n"} expand(@_);
  }
  
  sub nc_trace {
      my $level = shift;
      print $LogFH 
          map { sprintf "%-4s: %s\n", $colors{$level}, $_ } expand(@_);
  }
  
  {
      my $trace = HAS_COLOR ? \&c_trace : \&nc_trace;
  
      # if the level is sufficiently high, enable the tracing for a
      # given level otherwise assign NOP
      for my $level (@Levels,@Utils) {
          no strict 'refs';
          *$level = sub { 
              $trace->($level, @_) 
                  if ( $levels{$Level} || $levels{$default_level} ) >= $levels{$level};
          };
      }
  }
  
  1;
  __END__
  
  
  
  =head1 Apache::TestTrace - Helper output generation functions
  
  =head1 SYNOPSIS
  
      use Apache::TestTrace;
  
      # test sub that exercises all the tracing functions
      sub test {
          print $Apache::TestTrace::LogFH 
                "TraceLevel: $Apache::TestTrace::Level\n";
          $_->($_,[1..3],$_) for qw(emerg alert crit error
                                    warning notice info debug todo);
          print $Apache::TestTrace::LogFH "\n\n"
      };
  
      # demo the trace subs using default setting
      test();
  
      # override the default trace level with 'crit'
      $Apache::TestTrace::Level = 'crit';
      # now only 'crit' and higher levels will do tracing lower level
      test();
  
      # set the trace level to 'debug'
      $Apache::TestTrace::Level = 'debug';
      # now only 'debug' and higher levels will do tracing lower level
      test();
  
      open OUT, ">/tmp/foo" or die $!;
      # override the default Log filehandle
      $Apache::TestTrace::LogFH = \*OUT;
      # now the traces will go into a new filehandle
      test();
      close OUT;
  
  =head1 DESCRIPTION
  
  This module exports a number of functions that make it easier
  generating various diagnostics messages in your programs in a
  consistent way and saves some keystrokes as it handles the new lines
  and sends the messages to STDERR for you.
  
  This module provides the same trace methods as syslog(3)'s log
  levels. Listed from low level to high level: emerg(), alert(), crit(),
  error(), warning(), notice(), info(), debug(). The only different
  function is warning(), since warn is already taken by Perl.
  
  The module provides another trace function called todo() which is
  useful for todo items. It has the same level as I<debug> (the
  highest).
  
  If you have C<Term::ANSIColor> installed the diagnostic messages will
  be colorized, otherwise a special for each function prefix will be
  used.
  
  If C<Data::Dumper> is installed and you pass a reference to a variable
  to any of these functions, the variable will be dumped with
  C<Data::Dumper::Dumper()>.
  
  Functions whose level is above the level set in
  C<$Apache::TestTrace::Level> become NOPs. For example if the level is
  set to I<alert>, only alert() and emerg() functions will generate the
  output. The default setting of this variable is I<warning>. Other
  valid values are: I<emerg>, I<alert>, I<crit>, I<error>, I<warning>,
  I<notice>, I<info>, I<debug>.
  
  By default all the output generated by these functions goes to
  STDERR. You can override the default filehandler by overriding
  C<$Apache::TestTrace::LogFH> with a new filehandler.
  
  =head1 TODO
  
   o provide an option to disable the coloring altogether via some flag
     or import()
  
  =head1 AUTHOR
  
  Stas Bekman <stas@stason.org> and Doug MacEachern <dougm@covalent.com>.
  
  =cut
  
  
  
  
  1.3       +1 -0      modperl-2.0/Apache-Test/MANIFEST
  
  Index: MANIFEST
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Apache-Test/MANIFEST,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- MANIFEST	2001/04/03 04:23:43	1.2
  +++ MANIFEST	2001/06/21 07:40:07	1.3
  @@ -9,6 +9,7 @@
   lib/Apache/TestServer.pm
   lib/Apache/TestHandler.pm
   lib/Apache/TestMM.pm
  +lib/Apache/TestTrace.pm
   t/TEST
   t/ping.t
   t/request.t
  
  
  

Mime
View raw message