blib/lib/Devel/Trace.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 3 | 19 | 15.7 |
branch | 0 | 4 | 0.0 |
condition | n/a | ||
subroutine | 1 | 4 | 25.0 |
pod | 0 | 2 | 0.0 |
total | 4 | 29 | 13.7 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # -*- perl -*- | ||||||
2 | |||||||
3 | package Devel::Trace; | ||||||
4 | $VERSION = '0.12'; | ||||||
5 | $TRACE = 1; | ||||||
6 | |||||||
7 | # This is the important part. The rest is just fluff. | ||||||
8 | sub DB::DB { | ||||||
9 | 0 | 0 | 0 | 0 | return unless $TRACE; | ||
10 | 0 | my ($p, $f, $l) = caller; | |||||
11 | 0 | my $code = \@{"::_<$f"}; | |||||
0 | |||||||
12 | 0 | print STDERR ">> $f:$l: $code->[$l]"; | |||||
13 | } | ||||||
14 | |||||||
15 | |||||||
16 | sub import { | ||||||
17 | 0 | 0 | my $package = shift; | ||||
18 | 0 | foreach (@_) { | |||||
19 | 0 | 0 | if ($_ eq 'trace') { | ||||
20 | 0 | my $caller = caller; | |||||
21 | 0 | *{$caller . '::trace'} = \&{$package . '::trace'}; | |||||
0 | |||||||
0 | |||||||
22 | } else { | ||||||
23 | 1 | 1 | 916 | use Carp; | |||
1 | 2 | ||||||
1 | 276 | ||||||
24 | 0 | croak "Package $package does not export `$_'; aborting"; | |||||
25 | } | ||||||
26 | } | ||||||
27 | } | ||||||
28 | |||||||
29 | my %tracearg = ('on' => 1, 'off' => 0); | ||||||
30 | sub trace { | ||||||
31 | 0 | 0 | 0 | my $arg = shift; | |||
32 | 0 | $arg = $tracearg{$arg} while exists $tracearg{$arg}; | |||||
33 | 0 | $TRACE = $arg; | |||||
34 | } | ||||||
35 | |||||||
36 | 1; | ||||||
37 | |||||||
38 | |||||||
39 | =head1 NAME | ||||||
40 | |||||||
41 | Devel::Trace - Print out each line before it is executed (like C |
||||||
42 | |||||||
43 | =head1 SYNOPSIS | ||||||
44 | |||||||
45 | perl -d:Trace program | ||||||
46 | |||||||
47 | =head1 DESCRIPTION | ||||||
48 | |||||||
49 | If you run your program with C |
||||||
50 | will print a message to standard error just before each line is executed. | ||||||
51 | For example, if your program looks like this: | ||||||
52 | |||||||
53 | #!/usr/bin/perl | ||||||
54 | |||||||
55 | |||||||
56 | print "Statement 1 at line 4\n"; | ||||||
57 | print "Statement 2 at line 5\n"; | ||||||
58 | print "Call to sub x returns ", &x(), " at line 6.\n"; | ||||||
59 | |||||||
60 | exit 0; | ||||||
61 | |||||||
62 | |||||||
63 | sub x { | ||||||
64 | print "In sub x at line 12.\n"; | ||||||
65 | return 13; | ||||||
66 | } | ||||||
67 | |||||||
68 | Then the C |
||||||
69 | |||||||
70 | >> ./test:4: print "Statement 1 at line 4\n"; | ||||||
71 | >> ./test:5: print "Statement 2 at line 5\n"; | ||||||
72 | >> ./test:6: print "Call to sub x returns ", &x(), " at line 6.\n"; | ||||||
73 | >> ./test:12: print "In sub x at line 12.\n"; | ||||||
74 | >> ./test:13: return 13; | ||||||
75 | >> ./test:8: exit 0; | ||||||
76 | |||||||
77 | This is something like the shell's C<-x> option. | ||||||
78 | |||||||
79 | =head1 DETAILS | ||||||
80 | |||||||
81 | Inside your program, you can enable and disable tracing by doing | ||||||
82 | |||||||
83 | $Devel::Trace::TRACE = 1; # Enable | ||||||
84 | $Devel::Trace::TRACE = 0; # Disable | ||||||
85 | |||||||
86 | or | ||||||
87 | |||||||
88 | Devel::Trace::trace('on'); # Enable | ||||||
89 | Devel::Trace::trace('off'); # Disable | ||||||
90 | |||||||
91 | |||||||
92 | C |
||||||
93 | |||||||
94 | import Devel::Trace 'trace'; | ||||||
95 | |||||||
96 | Then if you want you just say | ||||||
97 | |||||||
98 | trace 'on'; # Enable | ||||||
99 | trace 'off'; # Disable | ||||||
100 | |||||||
101 | |||||||
102 | =head1 TODO | ||||||
103 | |||||||
104 | =over 4 | ||||||
105 | |||||||
106 | =item * | ||||||
107 | |||||||
108 | You should be able to send the trace output to the filehandle of your choice. | ||||||
109 | |||||||
110 | =item * | ||||||
111 | |||||||
112 | You should be able to specify the format of the output. | ||||||
113 | |||||||
114 | =item * | ||||||
115 | |||||||
116 | You should be able to get the output into a string. | ||||||
117 | |||||||
118 | =back | ||||||
119 | |||||||
120 | We'll see. | ||||||
121 | |||||||
122 | =head1 LICENSE | ||||||
123 | |||||||
124 | Devel::Trace 0.11 and its source code are hereby placed in the public domain. | ||||||
125 | |||||||
126 | =head1 Author | ||||||
127 | |||||||
128 | =begin text | ||||||
129 | |||||||
130 | Mark-Jason Dominus (C |
||||||
131 | |||||||
132 | See the C |
||||||
133 | for news and upgrades. | ||||||
134 | |||||||
135 | =end text | ||||||
136 | |||||||
137 | =begin man | ||||||
138 | |||||||
139 | Mark-Jason Dominus (C |
||||||
140 | |||||||
141 | See the C |
||||||
142 | for news and upgrades. | ||||||
143 | |||||||
144 | =end man | ||||||
145 | |||||||
146 | =begin html | ||||||
147 | Mark-Jason Dominus (mjd-perl-trace@plover.com), Plover Systems co. |
||||||
148 | See The Devel::Trace.pm Page for news and upgrades. |
||||||
149 | |||||||
150 | =end html | ||||||
151 | |||||||
152 | |||||||
153 | =cut | ||||||
154 |