File Coverage

blib/lib/Plack/Middleware/Debug/TraceENV.pm
Criterion Covered Total %
statement 58 58 100.0
branch 10 10 100.0
condition 6 8 75.0
subroutine 17 17 100.0
pod 2 2 100.0
total 93 95 97.8


line stmt bran cond sub pod time code
1             package Plack::Middleware::Debug::TraceENV;
2 8     8   486734 use strict;
  8         23  
  8         255  
3 8     8   48 use warnings;
  8         26  
  8         235  
4 8     8   523 use Plack::Util::Accessor qw/method/;
  8         312  
  8         58  
5 8     8   842 use parent qw/Plack::Middleware::Debug::Base/;
  8         324  
  8         46  
6             our $VERSION = '0.044';
7              
8             my $ENABLE = +{};
9              
10             sub prepare_app {
11 8     8 1 5603 my $self = shift;
12              
13 8 100 66     31 if ( $self->method
      66        
14 1         79 && ref($self->method) eq 'ARRAY' && scalar(@{$self->method}) > 0 ) {
15 1         7 map { $ENABLE->{lc($_)} = 1; } @{$self->method};
  1         11  
  1         5  
16             }
17             else {
18 7         326 map { $ENABLE->{$_} = 1; } qw/
  56         143  
19             fetch store exists delete clear scalar firstkey nextkey
20             /;
21             }
22              
23 8         42 tie %ENV, 'Plack::Middleware::Debug::TraceENV';
24             }
25              
26             my @TRACE;
27             my %COUNT;
28             sub run {
29 8     8 1 208879 my($self, $env, $panel) = @_;
30              
31 8         42 @TRACE = ();
32 8         28 %COUNT = ();
33              
34             return sub {
35 8     8   520 $panel->title('%ENV Tracer');
36             $panel->nav_subtitle(
37             sprintf(
38             "F:%s, S:%s, E:%s, D:%s",
39 8 100 100     83 map { $ENABLE->{$_} ? ($COUNT{uc($_)} || 0) : '-'; } qw/
  32         271  
40             fetch store exists delete
41             /,
42             )
43             );
44 8         113 $panel->content(
45             $self->render_list_pairs(\@TRACE),
46             );
47 8         76 };
48             }
49              
50             sub TIEHASH {
51 8     8   232 return bless +{ %ENV }, shift;
52             }
53              
54             sub FETCH {
55 32     32   176 _tracer('FETCH', $_[1], undef, caller() );
56 32         156 $_[0]->{$_[1]};
57             }
58              
59             sub STORE {
60 9     9   294 _tracer('STORE', $_[1], $_[2], caller() );
61 9         55 $_[0]->{$_[1]} = $_[2];
62             }
63              
64             sub EXISTS {
65 5     5   76 _tracer('EXISTS', $_[1], undef, caller() );
66 5         58 return exists($_[0]->{$_[1]});
67             }
68              
69             sub DELETE {
70 1     1   14 _tracer('DELETE', $_[1], undef, caller() );
71 1         12 delete $_[0]->{$_[1]};
72             }
73              
74             sub CLEAR {
75 1     1   17 _tracer('CLEAR', undef, undef, caller() );
76 1         2 %{$_[0]} = ();
  1         27  
77             }
78              
79             sub SCALAR {
80 1     1   11 _tracer('SCALAR', undef, undef, caller() );
81 1         3 scalar %{$_[0]};
  1         5  
82             }
83              
84             sub FIRSTKEY {
85 2     2   20 _tracer('FIRSTKEY', undef, undef, caller() );
86 2         4 my $a = scalar keys %{$_[0]};
  2         9  
87 2         12 each %{$_[0]};
  2         14  
88             }
89              
90             sub NEXTKEY {
91 59     59   193 _tracer('NEXTKEY', undef, undef, caller() );
92 59         98 each %{$_[0]};
  59         217  
93             }
94              
95             sub _tracer {
96 110     110   297 my ($method, $key, $value,
97             $package, $filename, $line) = @_;
98              
99 110 100       304 return unless $ENABLE->{lc($method)};
100              
101 109 100       241 $key = '' if !defined $key;
102 109 100       318 $key = "$key=$value" if defined $value;
103 109         433 push @TRACE, "$$: $method" => "$key [$filename#$line]";
104 109         310 $COUNT{$method}++;
105             }
106              
107             1;
108              
109             __END__