File Coverage

blib/lib/Plack/Middleware/Debug/HTML/Mason.pm
Criterion Covered Total %
statement 24 77 31.1
branch 0 12 0.0
condition 0 5 0.0
subroutine 8 13 61.5
pod 1 1 100.0
total 33 108 30.5


line stmt bran cond sub pod time code
1             package Plack::Middleware::Debug::HTML::Mason;
2             $Plack::Middleware::Debug::HTML::Mason::VERSION = '0.2';
3 1     1   16188 use strict;
  1         2  
  1         44  
4 1     1   5 use warnings;
  1         2  
  1         41  
5              
6 1     1   521 use parent qw(Plack::Middleware::Debug::Base);
  1         274  
  1         5  
7              
8             =head1 NAME
9              
10             Plack::Middleware::Debug::HTML::Mason - Debug info for old HTML::Mason apps.
11              
12             =head1 VERSION
13              
14             version 0.2
15              
16             =head1 SYNOPSIS
17              
18             # add this to your mason configuration
19             plugins => ['Plack::Middleware::Debug::HTML::Mason::Plugin']
20            
21             # and then enable the middleware
22             enable 'Debug::HTML::Mason';
23              
24             =head1 DESCRIPTION
25              
26             Provides a call tree and some basic configuration information for a request
27             processed by HTML::Mason.
28              
29             =cut
30              
31             my $root;
32             my @stack;
33             my %env;
34             my $ran;
35              
36             package Plack::Middleware::Debug::HTML::Mason::Plugin {
37 1     1   33160 use strict;
  1         3  
  1         51  
38 1     1   7 use warnings;
  1         1  
  1         50  
39 1     1   5 use parent qw(HTML::Mason::Plugin);
  1         3  
  1         14  
40 1     1   2061 use Time::HiRes qw(time);
  1         1946  
  1         5  
41 1     1   1077 use JSON;
  1         10229  
  1         5  
42              
43             my $json = JSON->new->convert_blessed(1)->allow_blessed(1)->allow_unknown(1)->utf8(1);
44            
45             sub start_component_hook {
46 0     0     my ($self, $context) = @_;
47            
48 0           my $frame = {
49             start => time(),
50             kids => [],
51             };
52 0   0       $root ||= [$frame];
53 0 0         if (@stack) {
54 0           my $parent= $stack[-1];
55 0           push @{$parent->{kids}}, $frame;
  0            
56             }
57 0           push @stack, $frame;
58             }
59            
60             sub end_component_hook {
61 0     0     my ($self, $context) = @_;
62            
63 0           my $frame = pop @stack;
64 0           my $name = $context->comp->title;
65            
66 0           my ($path, $root, $method) = $name =~ m/(.*) (\[.+?\])(:.+)?/;
67            
68 0 0         $frame->{name} = $method ? "$root $path$method" : "$root $path";
69 0           $frame->{end} = time();
70 0           $frame->{duration} = $frame->{end} - $frame->{start};
71 0           $frame->{args} = $json->encode($context->args);
72             }
73            
74             sub end_request_hook {
75 0     0     my ($self, $context) = @_;
76            
77 0           $env{main_comp} = $context->request->request_comp;
78 0           $env{args} = $context->args;
79 0           $env{comp_root} = $context->request->interp->comp_root;
80 0           $ran = 1;
81             }
82              
83             }
84              
85            
86             sub run {
87 0     0 1   my ($self, $env, $panel) = @_;
88            
89 0           $root = undef;
90 0           @stack = ();
91 0           %env = ();
92 0           $ran = 0;
93            
94             return sub {
95 0     0     my $res = shift;
96            
97 0           $panel->nav_title("HTML::Mason");
98 0           $panel->title("HTML::Mason Summary");
99            
100 0 0         unless ($ran) {
101 0           $panel->content('

No Data

No data was recorded by the mason plugin. Make sure mason is configured to use the Plack::Middleware::Debug::HTML::Mason::Plugin plugin.

');
102 0           return;
103             }
104            
105            
106 0           my $depth = 0;
107 0           my $frame;
108             my $walker;
109 0           my $html = '';
110 0           my $i = 0;
111             $walker = sub {
112 0           my ($context, $depth) = @_;
113 0 0 0       return unless $context && @$context;
114              
115            
116 0           foreach my $frame (@$context) {
117 0           my $margin = sprintf("%dpx", $depth * 16);
118 0           my $background;
119 0           $i++;
120 0 0         if ($i % 2) {
    0          
121 0           $background = '#f5f5f5';
122             }
123             elsif ($frame->{name} eq $env{main_comp}->title) {
124 0           $background = '#f0f0f0';
125             }
126             else {
127 0           $background = 'white';
128             }
129            
130 0           $html .= sprintf('
%s(%s) - %.5fs
',
131             $background,
132             $margin,
133             $frame->{name},
134             $frame->{args},
135             $frame->{duration},
136             );
137            
138 0           $walker->($frame->{kids}, $depth + 1);
139             }
140 0           };
141            
142 0           $walker->($root, 1);
143            
144 0           my $css = <
145            
157             END
158            
159 0           $panel->content(
160             $self->render_list_pairs([
161             'Main Comp' => $env{main_comp}->source_file,
162             'Args' => $env{args},
163             'Comp Root' => $env{comp_root},
164            
165             ]) .
166             qq|$css
$html
|
167             );
168 0           };
169             }
170              
171              
172              
173             =head1 TODO
174              
175             =over 2
176              
177             =item *
178              
179             The docs are pretty middling at the moment.
180              
181             =back
182              
183             =head1 AUTHORS
184              
185             Chris Reinhardt
186             crein@cpan.org
187              
188             David Hand
189             cogent@cpan.org
190            
191             =head1 COPYRIGHT
192              
193             This program is free software; you can redistribute
194             it and/or modify it under the same terms as Perl itself.
195              
196             The full text of the license can be found in the
197             LICENSE file included with this module.
198              
199             =head1 SEE ALSO
200              
201             L, L, perl(1)
202              
203             =cut
204              
205             1;
206             $Plack::Middleware::Debug::HTML::Mason::Plugin::VERSION = '0.2';
207             __END__