File Coverage

blib/lib/Apache/Voodoo/Debug/Native.pm
Criterion Covered Total %
statement 51 150 34.0
branch 3 36 8.3
condition 2 14 14.2
subroutine 8 31 25.8
pod 0 20 0.0
total 64 251 25.5


line stmt bran cond sub pod time code
1             ################################################################################
2             #
3             # Apache::Voodoo::Debug - handles operations associated with debugging output.
4             #
5             # This object is used by Voodoo internally to handling various types of debugging
6             # information and to produce end user display of that information. End users
7             # never interact with this module directly, instead they use the methods from
8             # the Apache::Voodoo base class.
9             #
10             ################################################################################
11             package Apache::Voodoo::Debug::Native;
12              
13             $VERSION = "3.0200";
14              
15 2     2   4844 use strict;
  2         4  
  2         77  
16 2     2   12 use warnings;
  2         6  
  2         84  
17              
18 2     2   14 use base("Apache::Voodoo::Debug::Common");
  2         9  
  2         10259  
19              
20 2     2   17 use Apache::Voodoo::Constants;
  2         4  
  2         50  
21              
22 2     2   2522 use DBI;
  2         19757  
  2         149  
23 2     2   21 use HTML::Template;
  2         6  
  2         51  
24 2     2   12 use JSON::DWIW;
  2         5  
  2         25  
25              
26             sub new {
27 3     3 0 8 my $class = shift;
28              
29 3         7 my $id = shift;
30 3         5 my $conf = shift;
31              
32 3         5 my $self = {};
33 3         8 bless($self,$class);
34              
35 3         20 $self->{id}->{app_id} = $id;
36              
37 3         33 my $ac = Apache::Voodoo::Constants->new();
38              
39 3         16 my @flags = qw(debug info warn error exception table trace);
40 3         12 my @flag2 = qw(profile params template_conf return_data session);
41              
42 3         11 $self->{enabled} = 0;
43 3 50 33     37 if ($conf eq "1" || (ref($conf) eq "HASH" && $conf->{all})) {
    0 33        
44 3         11 foreach (@flags,@flag2) {
45 36         75 $self->{enable}->{$_} = 1;
46             }
47 3         10 $self->{enable}->{anydebug} = 1;
48 3         6 $self->{enabled} = 1;
49             }
50             elsif (ref($conf) eq "HASH") {
51 0         0 foreach (@flags) {
52 0 0       0 if ($conf->{$_}) {
53 0         0 $self->{enable}->{$_} = 1;
54 0         0 $self->{enable}->{anydebug} = 1;
55 0         0 $self->{enabled} = 1;
56             }
57             }
58 0         0 foreach (@flag2) {
59 0 0       0 if ($conf->{$_}) {
60 0         0 $self->{enable}->{$_} = 1;
61 0         0 $self->{enabled} = 1;
62             }
63             }
64             }
65              
66 3 50       13 if ($self->{enabled}) {
67 3         10 my $file = $INC{"Apache/Voodoo/Constants.pm"};
68 3         24 $file =~ s/Constants.pm$/Debug\/html\/debug.tmpl/;
69              
70 3         30 $self->{template} = HTML::Template->new(
71             'filename' => $file,
72             'die_on_bad_params' => 0,
73             'global_vars' => 1,
74             'loop_context_vars' => 1
75             );
76              
77 3         13096 $self->{template}->param(
78             debug_root => $ac->debug_path(),
79             app_id => $self->{id}->{app_id}
80             );
81              
82 3         192 $self->{json} = JSON::DWIW->new({bad_char_policy => 'convert', pretty => 1});
83              
84 3         144 $self->{db_info} = $ac->debug_dbd();
85 3         8 my $dbh;
86 3         11 eval {
87 3         7 $dbh = DBI->connect(@{$self->{db_info}});
  3         36  
88             };
89 3 50       4665 if ($@) {
90 3         449 warn "Debugging infomation will be lost: $@";
91 3         15 $self->{enabled} = 0;
92 3         180 return;
93             }
94              
95             # From the DBI docs. This will give use the database server name
96 0           my $db_type = $dbh->get_info(17);
97              
98 0           eval {
99 0           require "Apache/Voodoo/Debug/Native/$db_type.pm";
100 0           my $class = 'Apache::Voodoo::Debug::Native::'.$db_type;
101 0           $self->{db} = $class->new();
102             };
103 0 0         if ($@) {
104 0           die "$db_type is not supported: $@";
105             }
106              
107 0           $self->{db}->init_db($dbh,$ac);
108             }
109              
110             # we always send this since is fundamental to identifying the request chain
111             # regardless of what other info we log
112 0           $self->{enable}->{url} = 1;
113 0           $self->{enable}->{status} = 1;
114 0           $self->{enable}->{session_id} = 1;
115              
116 0           return $self;
117             }
118              
119             sub init {
120 0     0 0   my $self = shift;
121 0           my $mp = shift;
122              
123 0 0         return unless $self->{enabled};
124              
125 0           $self->{id}->{request_id} = $mp->request_id();
126              
127 0   0       $self->{db}->set_dbh(DBI->connect(@{$self->{db_info}}) || die DBI->errstr);
128              
129 0           $self->_write({
130             type => 'request',
131             id => $self->{'id'}
132             });
133              
134 0           $self->{template}->param(request_id => $self->{id}->{request_id});
135             }
136              
137             sub enabled {
138 0     0 0   return $_[0]->{enabled};
139             }
140              
141             sub shutdown {
142 0     0 0   $_[0]->{db}->db_disconnect();
143 0           return;
144             }
145              
146 0     0 0   sub debug { my $self = shift; $self->_debug('debug', @_); }
  0            
147 0     0 0   sub info { my $self = shift; $self->_debug('info', @_); }
  0            
148 0     0 0   sub warn { my $self = shift; $self->_debug('warn', @_); }
  0            
149 0     0 0   sub error { my $self = shift; $self->_debug('error', @_); }
  0            
150 0     0 0   sub exception { my $self = shift; $self->_debug('exception',@_); }
  0            
151 0     0 0   sub trace { my $self = shift; $self->_debug('trace', @_); }
  0            
152 0     0 0   sub table { my $self = shift; $self->_debug('table', @_); }
  0            
153              
154             sub _debug {
155 0     0     my $self = shift;
156 0           my $type = shift;
157              
158 0 0         return unless $self->{'enable'}->{$type};
159              
160 0           my $data;
161 0 0 0       if (scalar(@_) > 1 || ref($_[0])) {
162             # if there's more than one item, or the item we have is a reference
163             # then we need to serialize it.
164 0           $data = $self->_encode(@_);
165             }
166             else {
167             # simple scalar can be logged as is.
168 0           $data = $_[0];
169             }
170              
171 0 0         my $full = ($type =~ /(exception|trace)/)?1:0;
172              
173 0           $self->_write({
174             type => 'debug',
175             id => $self->{id},
176             level => $type,
177             stack => $self->_encode([$self->stack_trace($full)]),
178             data => $data
179             });
180             }
181              
182             sub mark {
183 0     0 0   my $self = shift;
184              
185 0 0         return unless $self->{'enable'}->{'profile'};
186              
187 0           $self->_write({
188             type => 'profile',
189             id => $self->{id},
190             timestamp => shift,
191             data => shift
192             });
193             }
194              
195             sub return_data {
196 0     0 0   my $self = shift;
197              
198 0 0         return unless $self->{'enable'}->{'return_data'};
199              
200 0           $self->_write({
201             type => 'return_data',
202             id => $self->{id},
203             handler => shift,
204             method => shift,
205             data => $self->_encode(shift)
206             });
207             }
208              
209              
210             # these all behave the same way. With the execption of session_id which
211             # also inserts it into the underlying template.
212 0     0 0   sub url { my $self = shift; $self->_log('url', @_); }
  0            
213 0     0 0   sub status { my $self = shift; $self->_log('status', @_); }
  0            
214 0     0 0   sub params { my $self = shift; $self->_log('params', @_); }
  0            
215 0     0 0   sub template_conf { my $self = shift; $self->_log('template_conf', @_); }
  0            
216 0     0 0   sub session { my $self = shift; $self->_log('session', @_); }
  0            
217              
218             sub session_id {
219 0     0 0   my $self = shift;
220 0           my $id = shift;
221              
222 0           $self->{template}->param(session_id => $id);
223 0           $self->_log('session_id',$id);
224             }
225              
226             sub _log {
227 0     0     my $self = shift;
228 0           my $type = shift;
229              
230 0 0         return unless $self->{'enable'}->{$type};
231              
232 0           my $data;
233 0 0 0       if (scalar(@_) > 1 || ref($_[0])) {
234             # if there's more than one item, or the item we have is a reference
235             # then we need to serialize it.
236 0           $data = $self->_encode(@_);
237             }
238             else {
239             # simple scalar can be logged as is.
240 0           $data = $_[0];
241             }
242              
243 0           $self->_write({
244             type => $type,
245             id => $self->{id},
246             data => $data
247             });
248             }
249              
250             sub _encode {
251 0     0     my $self = shift;
252              
253 0           my $j;
254 0 0         if (scalar(@_) > 1) {
255 0           $j = $self->{json}->to_json(\@_);
256             }
257             else {
258 0           $j = $self->{json}->to_json($_[0]);
259             }
260              
261 0           return $j;
262             }
263              
264              
265             sub _write {
266 0     0     my $self = shift;
267 0           my $data = shift;
268              
269 0           my $handler = 'handle_'.$data->{'type'};
270              
271 0 0         if ($self->{db}->can($handler)) {
272 0           $self->{db}->$handler($data);
273             }
274             }
275              
276             sub finalize {
277 0     0 0   my $self = shift;
278              
279 0 0         return () unless $self->{enabled};
280              
281 0           foreach (keys %{$self->{'enable'}}) {
  0            
282 0           $self->{template}->param('enable_'.$_ => $self->{'enable'}->{$_});
283             }
284              
285 0           return (_DEBUG_ => $self->{template}->output());
286             }
287              
288             1;
289              
290             ################################################################################
291             # Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org).
292             # All rights reserved.
293             #
294             # You may use and distribute Apache::Voodoo under the terms described in the
295             # LICENSE file include in this package. The summary is it's a legalese version
296             # of the Artistic License :)
297             #
298             ################################################################################