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