File Coverage

blib/lib/Plack/Middleware/Debug/HTML/Mason.pm
Criterion Covered Total %
statement 24 78 30.7
branch 0 12 0.0
condition 0 5 0.0
subroutine 8 13 61.5
pod 1 1 100.0
total 33 109 30.2


line stmt bran cond sub pod time code
1             package Plack::Middleware::Debug::HTML::Mason;
2             $Plack::Middleware::Debug::HTML::Mason::VERSION = '0.3';
3 1     1   16022 use strict;
  1         1  
  1         35  
4 1     1   4 use warnings;
  1         1  
  1         25  
5              
6 1     1   506 use parent qw(Plack::Middleware::Debug::Base);
  1         244  
  1         4  
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.3
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. To use this panel the included plugin
28             C must be called by Mason. If
29             this panel is enabled, the C key will be set
30             in the psgi environment. This might be useful if you want load the plugin as
31             needed:
32              
33             if ($env->{'psgi.middleware.debug.htmlmason'}) {
34             $handler->interp->plugins(['Plack::Middleware::Debug::HTML::Mason::Plugin']);
35             }
36             else {
37             $handler->interp->plugins([]);
38             }
39            
40             ...
41              
42             =cut
43              
44             my $root;
45             my @stack;
46             my %env;
47             my $ran;
48              
49             package Plack::Middleware::Debug::HTML::Mason::Plugin {
50 1     1   26258 use strict;
  1         2  
  1         37  
51 1     1   4 use warnings;
  1         1  
  1         32  
52 1     1   4 use parent qw(HTML::Mason::Plugin);
  1         2  
  1         10  
53 1     1   1353 use Time::HiRes qw(time);
  1         1408  
  1         4  
54 1     1   807 use JSON;
  1         9853  
  1         5  
55              
56             my $json = JSON->new->convert_blessed(1)->allow_blessed(1)->allow_unknown(1)->utf8(1);
57            
58             sub start_component_hook {
59 0     0     my ($self, $context) = @_;
60            
61 0           my $frame = {
62             start => time(),
63             kids => [],
64             };
65 0   0       $root ||= [$frame];
66 0 0         if (@stack) {
67 0           my $parent= $stack[-1];
68 0           push @{$parent->{kids}}, $frame;
  0            
69             }
70 0           push @stack, $frame;
71             }
72            
73             sub end_component_hook {
74 0     0     my ($self, $context) = @_;
75            
76 0           my $frame = pop @stack;
77 0           my $name = $context->comp->title;
78            
79 0           my ($path, $root, $method) = $name =~ m/(.*) (\[.+?\])(:.+)?/;
80            
81 0 0         $frame->{name} = $method ? "$root $path$method" : "$root $path";
82 0           $frame->{end} = time();
83 0           $frame->{duration} = $frame->{end} - $frame->{start};
84 0           $frame->{args} = $json->encode($context->args);
85             }
86            
87             sub end_request_hook {
88 0     0     my ($self, $context) = @_;
89            
90 0           $env{main_comp} = $context->request->request_comp;
91 0           $env{args} = $context->args;
92 0           $env{comp_root} = $context->request->interp->comp_root;
93 0           $ran = 1;
94             }
95              
96             }
97              
98            
99             sub run {
100 0     0 1   my ($self, $env, $panel) = @_;
101            
102 0           $root = undef;
103 0           @stack = ();
104 0           %env = ();
105 0           $ran = 0;
106 0           $env->{'psgi.middleware.debug.htmlmason'} = 1;
107            
108             return sub {
109 0     0     my $res = shift;
110            
111 0           $panel->nav_title("HTML::Mason");
112 0           $panel->title("HTML::Mason Summary");
113            
114 0 0         unless ($ran) {
115 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.

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