Log-TraceMessages-1.4/0040755000103200010320000000000007764204570012366 5ustar ededLog-TraceMessages-1.4/Changes0100644000103200010320000000545507764204570013667 0ustar eded2003-12-05 22:37 ed * README, TraceMessages.pm, test.pl: Version 1.4. 2003-12-05 22:35 ed * test.pl: After setting $Logfile to undef, an extra call to t() is needed to close the file before it can be unlinked on Windows. 2003-06-21 14:29 ed * TraceMessages.pm: Uncuddled else as recommended by perlstyle. 2003-06-21 14:28 ed * TraceMessages.pm: Quoted ' in pod documentation so Emacs font-lock works. 2003-01-26 17:58 ed * TraceMessages.pm, test.pl: Version 1.3. test.pl now has its version number in a variable $VERSION where it can be easily checked to see it matches that in TraceMessages.pm. The only reason for this release is that the last one had the numbers mismatched! 2003-01-26 17:55 ed * mkdist: Use set -e to exit when any command fails (we don't want to start rming things when cd has failed, for example). Changed to use CVS and cvs2cl rather than RCS. Check that the versions in test.pl and TraceMessages.pm match. 2002-10-25 16:05 ed * README: Updated for version 1.2. 2002-09-26 21:49 ed * TraceMessages.pm: Bumped version to 1.2, and moved the assignment onto its own line so CPAN can parse it (hopefully). 2002-09-01 14:57 ed * README, TraceMessages.pm: Updated my email address. 2001-11-28 13:21 ed * README: Updated for version 1.1. 2001-11-28 13:16 ed * Makefile.PL: Added HTML::FromText as a dependency (thanks to cpan-testers for spotting this). 2001-02-12 17:45 ed * TraceMessages.pm: Reinstated isa(AutoLoader) - otherwise the Makefile goes wrong 2001-02-08 18:30 ed * test.pl: Lots of fiddling around trying to make it work after RCS corrupted it; changing variable names to stop that happening again. 2000-11-24 17:50 ed * test.pl: Added tests for $Logfile 2000-11-24 17:50 ed * TraceMessages.pm: Added $Logfile letting you change where messages are printed 2000-10-16 18:36 ed * mkdist: Load TraceMessages.pm from current directory to get version (not random one lying around in PERL5LIB) 2000-10-15 18:48 ed * mkdist: Works 2000-10-15 18:47 ed * MANIFEST: Sort properly - working around locale bug in GNU sort 2000-10-15 18:23 ed * MANIFEST: sorted 2000-10-15 18:21 ed * mkdist: Initial revision 2000-10-15 18:18 ed * MANIFEST: Added README 2000-10-15 18:17 ed * README: Initial revision 2000-10-15 18:06 ed * TraceMessages.pm: d() returns empty string (instead of undef) if trace is off - stops warnings 2000-10-15 17:57 ed * test.pl: Test code for t(), d(), check_argv() and $On, $CGI flags 2000-10-15 17:48 ed * TraceMessages.pm: Remember to require HTML::FromText before trying to use it 2000-10-15 17:08 ed * TraceMessages.pm: First working version - based on Dbg.pm 2000-10-15 16:54 ed * MANIFEST, Makefile.PL, TraceMessages.pm, test.pl: Initial revision Log-TraceMessages-1.4/MANIFEST0100644000103200010320000000007507172366626013522 0ustar ededChanges MANIFEST Makefile.PL README TraceMessages.pm test.pl Log-TraceMessages-1.4/Makefile.PL0100644000103200010320000000046407401161674014334 0ustar ededuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Log::TraceMessages', 'VERSION_FROM' => 'TraceMessages.pm', # finds $VERSION 'PREREQ_PM' => { 'HTML::FromText' => '1.004' }, ); Log-TraceMessages-1.4/README0100644000103200010320000000217507764204211013240 0ustar ededLog::TraceMessages, version 1.4 This module is a better way of putting 'hello there' trace messages in your code. It lets you turn tracing on and off without commenting out trace statements, and provides other useful things like HTML-ified trace messages for CGI scripts and an easy way to trace out data structures using Data::Dumper. From the pod documentation: use Log::TraceMessages qw(t d); $Log::TraceMessages::On = 1; t 'got to here'; t 'value of $a is ' . d($a); { local $Log::TraceMessages::On = 0; t 'this message will not be printed'; } $Log::TraceMessages::Logfile = 'log.out'; t 'this message will go to the file log.out'; $Log::TraceMessages::Logfile = undef; t 'and this message is on stderr as usual'; # For a CGI program producing HTML $Log::TraceMessages::CGI = 1; # Or to turn on trace if there's a command-line argument '--trace' Log::TraceMessages::check_argv(); This is free software and you may distribute it under the same terms as perl itself. There is no warranty. Since version 1.3 the test suite has been fixed to work on Windows. -- Ed Avis, ed@membled.com, 2003-12-05 Log-TraceMessages-1.4/TraceMessages.pm0100644000103200010320000001101507764204233015441 0ustar ededpackage Log::TraceMessages; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader); @EXPORT = qw(); @EXPORT_OK = qw(t trace d dmp); use vars '$VERSION'; $VERSION = '1.4'; use FileHandle; =pod =head1 NAME Log::TraceMessages - Perl extension for trace messages used in debugging =head1 SYNOPSIS use Log::TraceMessages qw(t d); $Log::TraceMessages::On = 1; t 'got to here'; t 'value of $a is ' . d($a); { local $Log::TraceMessages::On = 0; t 'this message will not be printed'; } $Log::TraceMessages::Logfile = 'log.out'; t 'this message will go to the file log.out'; $Log::TraceMessages::Logfile = undef; t 'and this message is on stderr as usual'; # For a CGI program producing HTML $Log::TraceMessages::CGI = 1; # Or to turn on trace if there's a command-line argument '--trace' Log::TraceMessages::check_argv(); =head1 DESCRIPTION This module is a slightly better way to put trace statements into your code than just calling print(). It provides an easy way to turn trace on and off for particular sections of code without having to comment out bits of source. =head1 USAGE =over =item $Log::TraceMessages::On Flag controlling whether tracing is on or off. You can set it as you wish, and of course it can be C-ized. The default is off. =cut use vars '$On'; $On = 0; =pod =item $Log::TraceMessages::Logfile The name of the file to which trace should be appended. If this is undefined (which is the default), then trace will be written to stderr, or to stdout if C<$CGI> is set. =cut use vars '$Logfile'; $Logfile = undef; my $curr_Logfile = $Logfile; my $fh = undef; =pod =item $Log::TraceMessages::CGI Flag controlling whether the program printing trace messages is a CGI program (default is no). This means that trace messages will be printed as HTML. Unless C<$Logfile> is also set, messages will be printed to stdout so they appear in the output page. =cut use vars '$CGI'; $CGI = 0; =pod =item t(messages) Print the given strings, if tracing is enabled. Unless C<$CGI> is true or C<$Logfile> is set, each message will be printed to stderr with a newline appended. =cut sub t(@) { return unless $On; if (defined $Logfile) { unless (defined $curr_Logfile and $curr_Logfile eq $Logfile) { if (defined $fh) { close $fh unless ($fh eq \*STDOUT or $fh eq \*STDERR); } undef $fh; } if (not defined $fh) { $fh = new FileHandle(">>$Logfile") or die "cannot append to $Logfile: $!"; # Autoflushing here is really just a kludge to let the # test suite work. Although it could be useful for # 'tail -f' etc. # $fh->autoflush(1); $curr_Logfile = $Logfile; } } else { if (defined $fh) { close $fh unless ($fh eq \*STDOUT or $fh eq \*STDERR); } $fh = $CGI ? \*STDOUT : \*STDERR; undef $curr_Logfile; } die if not defined $fh; my $s; foreach $s (@_) { if ($CGI) { require HTML::FromText; print $fh "\n
", HTML::FromText::text2html($s), "
\n" or die "cannot print to filehandle: $!"; } else { print $fh "$s\n" or die "cannot print to filehandle: $!"; } } } =pod =item trace(messages) Synonym for C. =cut sub trace(@) { &t } =pod =item d(scalar) Return a string representation of a scalarE<39>s value suitable for use in a trace statement. This is just a wrapper for Data::Dumper. C will exit with '' if trace is not turned on. This is to stop your program being slowed down by generating lots of strings for trace statements that are never printed. =cut sub d($) { return '' if not $On; require Data::Dumper; my $s = $_[0]; my $d = Data::Dumper::Dumper($s); $d =~ s/^\$VAR1 =\s*//; $d =~ s/;$//; chomp $d; return $d; } =pod =item dmp(scalar) Synonym for C. =cut sub dmp(@) { &d } =pod =item check_argv() Looks at the global C<@ARGV> of command-line parameters to find one called '--trace'. If this is found, it will be removed from C<@ARGV> and tracing will be turned on. Since tracing is off by default, calling C is a way to make your program print trace only when you ask for it from the command line. =cut sub check_argv() { my @new_argv = (); foreach (@ARGV) { if ($_ eq '--trace') { $On = 1; } else { push @new_argv, $_; } } @ARGV = @new_argv; } =pod =head1 AUTHOR Ed Avis, ed@membled.com =head1 SEE ALSO perl(1), Data::Dumper(3). =cut 1; __END__ Log-TraceMessages-1.4/test.pl0100644000103200010320000001316607764204245013705 0ustar eded# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' # # In case you're wondering, the curly braces round some variable names # are to stop interpretation by RCS :-(. # ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) my $VERSION = '1.4'; BEGIN { $| = 1; print "1..11\n"; } END {print "not ok 1\n" unless $loaded;} use Log::TraceMessages qw(t d trace dmp); $loaded = 1; print 'not ' if ${Log::TraceMessages::VERSION} ne $VERSION; print "ok 1\n"; ######################### End of black magic. use strict; use POSIX qw(tmpnam); my $test_str = 'test < > &'; my $debug = 0; my $out; # Test 2 - t() with $On == 1 ${Log::TraceMessages::On} = 1; ${Log::TraceMessages::CGI} = 0; $out = grab_output("t('$test_str')"); print 'not ' if $out->[0] ne '' or $out->[1] ne "$test_str\n"; print "ok 2\n"; # Test 3 - t() with $On == 0 ${Log::TraceMessages::On} = 0; $out = grab_output("t('$test_str')"); print 'not ' if $out->[0] ne '' or $out->[1] ne ''; print "ok 3\n"; # Test 4 - t() with $CGI == 1 ${Log::TraceMessages::On} = 1; ${Log::TraceMessages::CGI} = 1; $out = grab_output("t('$test_str')"); print 'not ' if $out->[0] ne "\n
test < > &
\n" or $out->[1] ne ''; print "ok 4\n"; # Test 5 - t() with $CGI == 0 after setting a logfile ${Log::TraceMessages::On} = 1; ${Log::TraceMessages::CGI} = 0; my $tmp = tmpnam(); ${Log::TraceMessages::Logfile} = $tmp; $out = grab_output("t('$test_str')"); ${Log::TraceMessages::Logfile} = undef; my $contents = read_file($tmp); print "contents of $tmp: $contents\n" if $debug; print 'not ' if $out->[0] ne '' or $out->[1] ne '' or $contents ne "$test_str\n"; print "ok 5\n"; # On Windows the file must be closed before unlinking, and that # doesn't happen until the next t(). # grab_output("t('')"); unlink $tmp or die "cannot unlink $tmp: $!"; # Test 6 - t() with $CGI == 1 after setting a different logfile ${Log::TraceMessages::On} = 1; ${Log::TraceMessages::CGI} = 1; my $tmp = tmpnam(); ${Log::TraceMessages::Logfile} = $tmp; $out = grab_output("t('$test_str')"); ${Log::TraceMessages::Logfile} = undef; my $contents = read_file($tmp); print "contents of $tmp: $contents\n" if $debug; print 'not ' if $out->[0] ne '' or $out->[1] ne '' or $contents ne "\n
test < > &
\n"; print "ok 6\n"; grab_output("t('')"); # Windows - see above unlink $tmp or die "cannot unlink $tmp: $!"; # Test 7 - quick check that trace() works (no logfile now) ${Log::TraceMessages::On} = 1; ${Log::TraceMessages::CGI} = 0; $out = grab_output("trace('$test_str')"); print 'not ' if $out->[0] ne '' or $out->[1] ne "$test_str\n"; print "ok 7\n"; # Test 8 - d(). But this is not a full test suite for Data::Dumper. ${Log::TraceMessages::On} = 1; my $a; eval '$a = ' . d($test_str); print 'not ' if $a ne $test_str; print "ok 8\n"; # Test 9 - check that d() does nothing when trace is off ${Log::TraceMessages::On} = 0; print 'not ' if d($test_str) ne ''; print "ok 9\n"; # Test 10 - quick check that dmp() works ${Log::TraceMessages::On} = 1; my $a; eval '$a = ' . dmp($test_str); print 'not ' if $a ne $test_str; print "ok 10\n"; # Test 11 - check_argv() ${Log::TraceMessages::On} = 0; my $num_args = @ARGV; @ARGV = (@ARGV, '--trace'); Log::TraceMessages::check_argv(); print 'not ' if @ARGV != $num_args or not ${Log::TraceMessages::On}; print "ok 11\n"; # grab_output() # # Eval some code and return what was printed to stdout and stderr. # # Parameters: string of code to eval # # Returns: listref of [ stdout text, stderr text ] # sub grab_output($) { die 'usage: grab_stderr(string to eval)' if @_ != 1; my $code = shift; require POSIX; my $tmp_o = POSIX::tmpnam(); my $tmp_e = POSIX::tmpnam(); local *OLDOUT, *OLDERR; print "running code: $code\n" if $debug; # Changing $SIG{__DIE__} seems to cause problems elsewhere, even # if you set it back again or undefine it afterwards. So we use # this as a replacement for die(). # sub dy($) { print "$_[0]\n"; print STDERR "$_[0]\n"; exit(1) } open(OLDOUT, ">&STDOUT") or dy "can't dup stdout: $!"; open(OLDERR, ">&STDERR") or dy "can't dup stderr: $!"; open(STDOUT, ">$tmp_o") or dy "can't open stdout to $tmp_o: $!"; open(STDERR, ">$tmp_e") or dy "can't open stderr to $tmp_e: $!"; eval $code; close(STDOUT) or dy "cannot close stdout opened to $tmp_o: $!"; close(STDERR) or dy "will anyone ever see this message? $!"; open(STDOUT, ">&OLDOUT") or dy "can't dup stdout back again: $!"; open(STDERR, ">&OLDERR") or dy "can't dup stderr back again: $!"; dy $@ if $@; local $/ = undef; open (TMP_O, $tmp_o) or dy "cannot open $tmp_o: $!"; open (TMP_E, $tmp_e) or dy "cannot open $tmp_e: $!"; my $o = ; my $e = ; close TMP_O or dy "cannot close filehandle opened to $tmp_o: $!"; close TMP_E or dy "cannot close filehandle opened to $tmp_e: $!"; unlink $tmp_o or dy "cannot unlink $tmp_o: $!"; unlink $tmp_e or dy "cannot unlink $tmp_e: $!"; if ($debug) { print "stdout: $o\n"; print "stderr: $e\n"; } return [ $o, $e ]; } # read_file() # # Read a file's contents and return them as a string. # sub read_file($) { die 'usage: read_file(filename)' if @_ != 1; my $f = shift; my $fh = new FileHandle($f); die "cannot open $f: $!" if not $fh; local $/ = undef; my $r = <$fh>; close $fh or die "cannot close filehandle opened to $f: $!"; return $r; }