File Coverage

blib/lib/PostgreSQL/PLPerl/Trace.pm
Criterion Covered Total %
statement 19 19 100.0
branch 10 12 83.3
condition 2 2 100.0
subroutine 1 1 100.0
pod 0 1 0.0
total 32 35 91.4


line stmt bran cond sub pod time code
1             package PostgreSQL::PLPerl::Trace;
2             our $VERSION = '1.001';
3              
4             =head1 NAME
5              
6             PostgreSQL::PLPerl::Trace - Simple way to trace execution of Perl statements in PL/Perl
7              
8             =head1 VERSION
9              
10             version 1.001
11              
12             =head1 SYNOPSIS
13              
14             Load via a line in your F file:
15              
16             use PostgreSQL::PLPerl::Trace;
17              
18             Load via the C environment variable:
19              
20             $ PERL5OPT='-MPostgreSQL::PLPerl::Trace' pg_ctl ...
21              
22             =head1 DESCRIPTION
23              
24             Writes a line to the PostgreSQL log file for every PL/Perl statement executed.
25             This can generate truly I amounts of log data and also slows excution
26             of PL/Perl code by at least a couple of orders of magnitude.
27              
28             Why would you want to do this? Well, there are times when it's a simple and
29             effective way to see what PL/Perl code is I being executed.
30              
31             This module is based on L but modified to work with PostgreSQL PL/Perl
32             for both the C language I, more significantly, for the C
33             language as well. It also shows the subroutine name whenever execution moves
34             from one subroutine to another.
35              
36             =head1 ENABLING
37              
38             In order to use this module you need to arrange for it to be loaded when
39             PostgreSQL initializes a Perl interpreter.
40              
41             Create a F file in the same directory as your
42             F file, if it doesn't exist already.
43              
44             In the F file write the code to load this module:
45              
46             use PostgreSQL::PLPerl::Trace;
47              
48             When it's no longer needed just comment it out by prefixing with a C<#>.
49              
50             =head2 PostgreSQL 8.x
51              
52             Set the C before starting postgres, to something like this:
53              
54             PERL5OPT='-e "require q{plperlinit.pl}"'
55              
56             The code in the F should also include C
57             to avoid any problems with nested invocations of perl, e.g., via a C
58             function.
59              
60             =head2 PostgreSQL 9.0
61              
62             For PostgreSQL 9.0 you can still use the C method described above.
63             Alternatively, and preferably, you can use the C configuration
64             variable in the F file.
65              
66             plperl.on_init='require q{plperlinit.pl};'
67              
68             =head2 Alternative Method
69              
70             It you're not already using the C environment variable to load a
71             F file, as described above, then you can use it as a quick way
72             to load the module for ad-hoc use:
73              
74             $ PERL5OPT='-MPostgreSQL::PLPerl::Trace' pg_ctl ...
75              
76             =head1 AUTHOR
77              
78             Tim Bunce L
79              
80             Copyright (c) Tim Bunce, Ireland, 2010. All rights reserved.
81             You may use and distribute on the same terms as Perl 5.10.1.
82              
83             With thanks to L for sponsoring development.
84              
85             =cut
86              
87             # these are currently undocumented but used by tests
88             our $TRACE; $TRACE = 1 unless defined $TRACE;
89             our $fh; $fh = \*STDERR unless defined $fh;
90              
91             my $main_glob = *{"main::"};
92             my $main_stash = \%{$main_glob}; # get ref to true main glob outside of Safe
93             my $file_sub_prev = '';
94              
95             # maybe move core of this to to a new Devel::TraceSafe module
96              
97             sub DB::DB { # magic sub
98              
99 5944 100   5944 0 72772 return unless $TRACE;
100              
101 199         428 my ($p, $f, $l) = caller();
102              
103 199         210 my $code = \@{"::_<$f"};
  199         376  
104 199 100       305 if (!@$code) { # probably inside Safe
105 1         5 my $glob = $main_stash->{"_<$f"};
106 1         1 $code = \@{$glob};
  1         3  
107             }
108              
109 199   100     639 my $sub = (caller(1))[3] || '???';
110 199         291 my $linesrc = $code->[$l];
111 199 100       292 if (!$linesrc) { # should never happen
112 1 50       5 my $submsg = $sub ? " for sub $sub" : "";
113 1         4 $linesrc = "\t(missing src$submsg in $p)";
114             }
115 199         198 chomp $linesrc;
116              
117 199         260 my $file_sub = "$f/$sub";
118 199 100       352 if ($file_sub ne $file_sub_prev) {
119 11 50       29 print $fh "-- in $sub:\n" if $sub;
120 11         14 $file_sub_prev = $file_sub;
121             }
122              
123 199         973 print $fh ">> $f:$l: $linesrc\n";
124             }
125              
126              
127             $^P |= 0
128             | 0x002 # Line-by-line debugging & save src lines.
129             | 0x004 # Switch off optimizations.
130             # | 0x008 # Preserve more data for future interactive inspections.
131             # | 0x010 # Keep info about source lines on which a subroutine is defined.
132             | 0x020 # Start with single-step on.
133             | 0x100 # Provide informative "file" names for evals
134             | 0x200 # Provide informative names to anonymous subroutines
135             | 0x400 # Save source code lines into "@{"_<$filename"}".
136             ;
137              
138             1;
139              
140             # vim: ts=8:sw=4:et