r2812 - in /packages/liblog-tracemessages-perl: ./ branches/
branches/upstream/ branches/upstream/current/ tags/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat May 27 12:31:45 UTC 2006
Author: gregoa-guest
Date: Sat May 27 12:31:44 2006
New Revision: 2812
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2812
Log:
[svn-inject] Installing original source of liblog-tracemessages-perl
Added:
packages/liblog-tracemessages-perl/
packages/liblog-tracemessages-perl/branches/
packages/liblog-tracemessages-perl/branches/upstream/
packages/liblog-tracemessages-perl/branches/upstream/current/
packages/liblog-tracemessages-perl/branches/upstream/current/Changes
packages/liblog-tracemessages-perl/branches/upstream/current/MANIFEST
packages/liblog-tracemessages-perl/branches/upstream/current/Makefile.PL
packages/liblog-tracemessages-perl/branches/upstream/current/README
packages/liblog-tracemessages-perl/branches/upstream/current/TraceMessages.pm
packages/liblog-tracemessages-perl/branches/upstream/current/test.pl
packages/liblog-tracemessages-perl/tags/
Added: packages/liblog-tracemessages-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblog-tracemessages-perl/branches/upstream/current/Changes?rev=2812&op=file
==============================================================================
--- packages/liblog-tracemessages-perl/branches/upstream/current/Changes (added)
+++ packages/liblog-tracemessages-perl/branches/upstream/current/Changes Sat May 27 12:31:44 2006
@@ -1,0 +1,129 @@
+2003-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
+
Added: packages/liblog-tracemessages-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblog-tracemessages-perl/branches/upstream/current/MANIFEST?rev=2812&op=file
==============================================================================
--- packages/liblog-tracemessages-perl/branches/upstream/current/MANIFEST (added)
+++ packages/liblog-tracemessages-perl/branches/upstream/current/MANIFEST Sat May 27 12:31:44 2006
@@ -1,0 +1,6 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+TraceMessages.pm
+test.pl
Added: packages/liblog-tracemessages-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblog-tracemessages-perl/branches/upstream/current/Makefile.PL?rev=2812&op=file
==============================================================================
--- packages/liblog-tracemessages-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/liblog-tracemessages-perl/branches/upstream/current/Makefile.PL Sat May 27 12:31:44 2006
@@ -1,0 +1,8 @@
+use 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' },
+);
Added: packages/liblog-tracemessages-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblog-tracemessages-perl/branches/upstream/current/README?rev=2812&op=file
==============================================================================
--- packages/liblog-tracemessages-perl/branches/upstream/current/README (added)
+++ packages/liblog-tracemessages-perl/branches/upstream/current/README Sat May 27 12:31:44 2006
@@ -1,0 +1,36 @@
+Log::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 at membled.com, 2003-12-05
Added: packages/liblog-tracemessages-perl/branches/upstream/current/TraceMessages.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblog-tracemessages-perl/branches/upstream/current/TraceMessages.pm?rev=2812&op=file
==============================================================================
--- packages/liblog-tracemessages-perl/branches/upstream/current/TraceMessages.pm (added)
+++ packages/liblog-tracemessages-perl/branches/upstream/current/TraceMessages.pm Sat May 27 12:31:44 2006
@@ -1,0 +1,229 @@
+package Log::TraceMessages;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+
+require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader);
+ at 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<local>-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<pre>", HTML::FromText::text2html($s), "</pre>\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<t(messages)>.
+
+=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<d()> 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<d(scalar)>.
+
+=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<check_argv()> 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 at membled.com
+
+=head1 SEE ALSO
+
+perl(1), Data::Dumper(3).
+
+=cut
+
+1;
+__END__
Added: packages/liblog-tracemessages-perl/branches/upstream/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/liblog-tracemessages-perl/branches/upstream/current/test.pl?rev=2812&op=file
==============================================================================
--- packages/liblog-tracemessages-perl/branches/upstream/current/test.pl (added)
+++ packages/liblog-tracemessages-perl/branches/upstream/current/test.pl Sat May 27 12:31:44 2006
@@ -1,0 +1,181 @@
+# 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<pre>test < > &</pre>\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<pre>test < > &</pre>\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;
+ at 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 = <TMP_O>; my $e = <TMP_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;
+}
More information about the Pkg-perl-cvs-commits
mailing list