File Coverage

blib/lib/Log/TraceMessages.pm
Criterion Covered Total %
statement 57 58 98.2
branch 23 32 71.8
condition 6 9 66.6
subroutine 12 12 100.0
pod 5 5 100.0
total 103 116 88.7


line stmt bran cond sub pod time code
1             package Log::TraceMessages;
2              
3 1     1   794 use strict;
  1         1  
  1         39  
4 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         2  
  1         121  
5              
6             require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader);
7             @EXPORT = qw(); @EXPORT_OK = qw(t trace d dmp);
8 1     1   5 use vars '$VERSION';
  1         5  
  1         44  
9             $VERSION = '1.4';
10              
11 1     1   975 use FileHandle;
  1         14234  
  1         7  
12              
13             =pod
14              
15             =head1 NAME
16              
17             Log::TraceMessages - Perl extension for trace messages used in debugging
18              
19             =head1 SYNOPSIS
20              
21             use Log::TraceMessages qw(t d);
22             $Log::TraceMessages::On = 1;
23             t 'got to here';
24             t 'value of $a is ' . d($a);
25             {
26             local $Log::TraceMessages::On = 0;
27             t 'this message will not be printed';
28             }
29              
30             $Log::TraceMessages::Logfile = 'log.out';
31             t 'this message will go to the file log.out';
32             $Log::TraceMessages::Logfile = undef;
33             t 'and this message is on stderr as usual';
34              
35             # For a CGI program producing HTML
36             $Log::TraceMessages::CGI = 1;
37              
38             # Or to turn on trace if there's a command-line argument '--trace'
39             Log::TraceMessages::check_argv();
40              
41             =head1 DESCRIPTION
42              
43             This module is a slightly better way to put trace statements into your
44             code than just calling print(). It provides an easy way to turn trace
45             on and off for particular sections of code without having to comment
46             out bits of source.
47              
48             =head1 USAGE
49              
50             =over
51              
52             =item $Log::TraceMessages::On
53              
54             Flag controlling whether tracing is on or off. You can set it as you
55             wish, and of course it can be C-ized. The default is off.
56              
57             =cut
58 1     1   505 use vars '$On';
  1         2  
  1         77  
59             $On = 0;
60              
61             =pod
62              
63              
64             =item $Log::TraceMessages::Logfile
65              
66             The name of the file to which trace should be appended. If this is
67             undefined (which is the default), then trace will be written to
68             stderr, or to stdout if C<$CGI> is set.
69              
70             =cut
71 1     1   7 use vars '$Logfile';
  1         2  
  1         62  
72             $Logfile = undef;
73             my $curr_Logfile = $Logfile;
74             my $fh = undef;
75              
76             =pod
77              
78              
79             =item $Log::TraceMessages::CGI
80              
81             Flag controlling whether the program printing trace messages is a CGI
82             program (default is no). This means that trace messages will be
83             printed as HTML. Unless C<$Logfile> is also set, messages will be
84             printed to stdout so they appear in the output page.
85              
86             =cut
87 1     1   5 use vars '$CGI';
  1         2  
  1         784  
88             $CGI = 0;
89              
90             =pod
91              
92              
93             =item t(messages)
94              
95             Print the given strings, if tracing is enabled. Unless C<$CGI> is
96             true or C<$Logfile> is set, each message will be printed to stderr
97             with a newline appended.
98              
99             =cut
100             sub t(@) {
101 8 100   8 1 6685 return unless $On;
102            
103 7 100       19 if (defined $Logfile) {
104 2 50 33     12 unless (defined $curr_Logfile and $curr_Logfile eq $Logfile) {
105 2 50       6 if (defined $fh) {
106 2 50 66     21 close $fh unless ($fh eq \*STDOUT or $fh eq \*STDERR);
107             }
108 2         8 undef $fh;
109             }
110              
111 2 50       6 if (not defined $fh) {
112 2 50       18 $fh = new FileHandle(">>$Logfile")
113             or die "cannot append to $Logfile: $!";
114              
115             # Autoflushing here is really just a kludge to let the
116             # test suite work. Although it could be useful for
117             # 'tail -f' etc.
118             #
119 2         232 $fh->autoflush(1);
120              
121 2         84 $curr_Logfile = $Logfile;
122             }
123             }
124             else {
125 5 100       15 if (defined $fh) {
126 4 100 100     59 close $fh unless ($fh eq \*STDOUT or $fh eq \*STDERR);
127             }
128 5 100       15 $fh = $CGI ? \*STDOUT : \*STDERR;
129 5         11 undef $curr_Logfile;
130             }
131 7 50       18 die if not defined $fh;
132              
133 7         8 my $s;
134 7         16 foreach $s (@_) {
135 7 100       13 if ($CGI) {
136 3         1091 require HTML::FromText;
137 3 50       36667 print $fh "\n
", HTML::FromText::text2html($s), "
\n"
138             or die "cannot print to filehandle: $!";
139             }
140             else {
141 4 50       145 print $fh "$s\n"
142             or die "cannot print to filehandle: $!";
143             }
144             }
145             }
146              
147             =pod
148              
149              
150             =item trace(messages)
151              
152             Synonym for C.
153              
154             =cut
155 1     1 1 848 sub trace(@) { &t }
156              
157             =pod
158              
159              
160             =item d(scalar)
161              
162             Return a string representation of a scalarE<39>s value suitable for
163             use in a trace statement. This is just a wrapper for Data::Dumper.
164              
165             C will exit with '' if trace is not turned on. This is to
166             stop your program being slowed down by generating lots of strings for
167             trace statements that are never printed.
168              
169             =cut
170             sub d($) {
171 3 100   3 1 469 return '' if not $On;
172 2         1319 require Data::Dumper;
173 2         20026 my $s = $_[0];
174 2         10 my $d = Data::Dumper::Dumper($s);
175 2         148 $d =~ s/^\$VAR1 =\s*//;
176 2         9 $d =~ s/;$//;
177 2         4 chomp $d;
178 2         141 return $d;
179             }
180              
181             =pod
182              
183              
184             =item dmp(scalar)
185              
186             Synonym for C.
187              
188             =cut
189 1     1 1 28 sub dmp(@) { &d }
190              
191             =pod
192              
193              
194             =item check_argv()
195              
196             Looks at the global C<@ARGV> of command-line parameters to find one
197             called '--trace'. If this is found, it will be removed from C<@ARGV>
198             and tracing will be turned on. Since tracing is off by default,
199             calling C is a way to make your program print trace only
200             when you ask for it from the command line.
201              
202             =cut
203             sub check_argv() {
204 1     1 1 40 my @new_argv = ();
205 1         5 foreach (@ARGV) {
206 1 50       5 if ($_ eq '--trace') {
207 1         4 $On = 1;
208             }
209             else {
210 0         0 push @new_argv, $_;
211             }
212             }
213 1         4 @ARGV = @new_argv;
214             }
215              
216             =pod
217              
218             =head1 AUTHOR
219              
220             Ed Avis, ed@membled.com
221              
222             =head1 SEE ALSO
223              
224             perl(1), Data::Dumper(3).
225              
226             =cut
227              
228             1;
229             __END__