File Coverage

blib/lib/Plack/Middleware/Debug/HTML/Mason.pm
Criterion Covered Total %
statement 24 72 33.3
branch 0 10 0.0
condition 0 5 0.0
subroutine 8 13 61.5
pod 1 1 100.0
total 33 101 32.6


line stmt bran cond sub pod time code
1             package Plack::Middleware::Debug::HTML::Mason;
2             $Plack::Middleware::Debug::HTML::Mason::VERSION = '0.1';
3 1     1   16541 use strict;
  1         2  
  1         39  
4 1     1   3 use warnings;
  1         1  
  1         29  
5              
6 1     1   432 use parent qw(Plack::Middleware::Debug::Base);
  1         285  
  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.1
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              
35             package Plack::Middleware::Debug::HTML::Mason::Plugin {
36 1     1   26105 use strict;
  1         2  
  1         34  
37 1     1   4 use warnings;
  1         1  
  1         30  
38 1     1   3 use parent qw(HTML::Mason::Plugin);
  1         2  
  1         5  
39 1     1   1391 use Time::HiRes qw(time);
  1         1503  
  1         4  
40 1     1   882 use JSON;
  1         10056  
  1         7  
41              
42             my $json = JSON->new->convert_blessed(1)->allow_blessed(1)->allow_unknown(1)->utf8(1);
43            
44             sub start_component_hook {
45 0     0     my ($self, $context) = @_;
46            
47 0           my $frame = {
48             start => time(),
49             kids => [],
50             };
51 0   0       $root ||= [$frame];
52 0 0         if (@stack) {
53 0           my $parent= $stack[-1];
54 0           push @{$parent->{kids}}, $frame;
  0            
55             }
56 0           push @stack, $frame;
57             }
58            
59             sub end_component_hook {
60 0     0     my ($self, $context) = @_;
61            
62 0           my $frame = pop @stack;
63 0           my $name = $context->comp->title;
64            
65 0           my ($path, $root, $method) = $name =~ m/(.*) (\[.+?\])(:.+)?/;
66            
67 0 0         $frame->{name} = $method ? "$root $path$method" : "$root $path";
68 0           $frame->{end} = time();
69 0           $frame->{duration} = $frame->{end} - $frame->{start};
70 0           $frame->{args} = $json->encode($context->args);
71             }
72            
73             sub end_request_hook {
74 0     0     my ($self, $context) = @_;
75            
76 0           $env{main_comp} = $context->request->request_comp;
77 0           $env{args} = $context->args;
78 0           $env{comp_root} = $context->request->interp->comp_root;
79             }
80              
81             }
82              
83            
84             sub run {
85 0     0 1   my ($self, $env, $panel) = @_;
86            
87 0           $root = undef;
88 0           @stack = ();
89 0           %env = ();
90            
91             return sub {
92 0     0     my $res = shift;
93            
94 0           $panel->nav_title("HTML::Mason");
95 0           $panel->title("HTML::Mason Summary");
96            
97 0           my $depth = 0;
98 0           my $frame;
99             my $walker;
100 0           my $html = '';
101 0           my $i = 0;
102             $walker = sub {
103 0           my ($context, $depth) = @_;
104 0 0 0       return unless $context && @$context;
105              
106            
107 0           foreach my $frame (@$context) {
108 0           my $margin = sprintf("%dpx", $depth * 16);
109 0           my $background;
110 0           $i++;
111 0 0         if ($i % 2) {
    0          
112 0           $background = '#f5f5f5';
113             }
114             elsif ($frame->{name} eq $env{main_comp}->title) {
115 0           $background = '#f0f0f0';
116             }
117             else {
118 0           $background = 'white';
119             }
120            
121 0           $html .= sprintf('
%s(%s) - %.5fs
',
122             $background,
123             $margin,
124             $frame->{name},
125             $frame->{args},
126             $frame->{duration},
127             );
128            
129 0           $walker->($frame->{kids}, $depth + 1);
130             }
131 0           };
132            
133 0           $walker->($root, 1);
134            
135 0           my $css = <
136            
148             END
149            
150 0           $panel->content(
151             $self->render_list_pairs([
152             'Main Comp' => $env{main_comp}->source_file,
153             'Args' => $env{args},
154             'Comp Root' => $env{comp_root},
155            
156             ]) .
157             qq|$css
$html
|
158             );
159 0           };
160             }
161              
162             1;
163             $Plack::Middleware::Debug::HTML::Mason::Plugin::VERSION = '0.1';
164             __END__