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 <[EMAIL PROTECTED]> and Doug MacEachern <[EMAIL PROTECTED]>. =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