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__ |