File Coverage

blib/lib/Plack/Middleware/Profiler/NYTProf.pm
Criterion Covered Total %
statement 108 130 83.0
branch 28 46 60.8
condition 3 9 33.3
subroutine 36 41 87.8
pod 2 11 18.1
total 177 237 74.6


line stmt bran cond sub pod time code
1             package Plack::Middleware::Profiler::NYTProf;
2 4     4   2006 use strict;
  4         8  
  4         133  
3 4     4   19 use warnings;
  4         5  
  4         116  
4 4     4   3140 use parent qw(Plack::Middleware);
  4         1321  
  4         28  
5             our $VERSION = '0.16';
6              
7 4         24 use Plack::Util::Accessor qw(
8             enable_profile
9             enable_reporting
10             env_nytprof
11             generate_profile_id
12             profiling_result_dir
13             report_dir
14             nytprofhtml_path
15             profiling_result_file_name
16             nullfile_name
17             before_profile
18             after_profile
19 4     4   77636 );
  4         11  
20              
21 4     4   429 use File::Spec;
  4         9  
  4         93  
22 4     4   55136 use Time::HiRes qw(gettimeofday);
  4         118641  
  4         26  
23 4     4   22925 use File::Which;
  4         5379  
  4         332  
24              
25 4     4   30 use constant PROFILE_ID => 'psgix.profiler.nytprof.reqid';
  4         12  
  4         226  
26 4     4   27 use constant PROFILER_ENABLED => 'psgix.profiler.nytprof.enabled';
  4         10  
  4         9878  
27              
28             my %PROFILER_SETUPED;
29              
30             my $NYTPROF_LOADED = 0;
31              
32             # Devel::NYTProf requires to be loaded in a compile phase.
33             # So you should call this method in the BEGIN of your app.psgi with the NYTPROF environment variable.
34             sub preload {
35 0   0 0 0 0 $ENV{NYTPROF} ||= _default_env();
36 0         0 require Devel::NYTProf;
37 0         0 DB::disable_profile();
38 0         0 $NYTPROF_LOADED = 1;
39             }
40              
41 1     1   27 sub _default_env { 'start=no:sigexit=int' }
42              
43             sub prepare_app {
44 3     3 1 238 my $self = shift;
45              
46 3         13 $self->_setup_profile_id;
47 3         28 $self->_setup_profiling_file_paths;
48 3         40 $self->_setup_profiling_hooks;
49 3         24 $self->_setup_enable_profile;
50 3         38 $self->_setup_enable_reporting;
51 3         29 $self->_setup_report_dir;
52 3         23 $self->_setup_nytprofhtml_path;
53             }
54              
55             sub _setup_profiling_file_paths {
56 3     3   7 my $self = shift;
57 3         39 $self->_setup_profiling_result_dir;
58 3         20 $self->_setup_profiling_result_file_name;
59 3         21 $self->_setup_nullfile_name;
60             }
61              
62             sub _setup_enable_reporting {
63 3     3   5 my $self = shift;
64 3 50       12 $self->enable_reporting(1) unless defined $self->enable_reporting;
65             }
66              
67             sub _setup_enable_profile {
68 3     3   5 my $self = shift;
69 3 100   4   14 $self->enable_profile( sub {1} ) unless $self->enable_profile;
  4         74  
70             }
71              
72             sub _setup_profiling_result_dir {
73 3     3   61 my $self = shift;
74 1     1   11 $self->profiling_result_dir( sub {'.'} )
75 3 100       13 unless is_code_ref( $self->profiling_result_dir );
76             }
77              
78             sub _setup_report_dir {
79 3     3   8 my $self = shift;
80 0     0   0 $self->report_dir( sub {'report'} )
81 3 50       11 unless is_code_ref( $self->report_dir );
82             }
83              
84             sub _setup_nytprofhtml_path {
85 3     3   6 my $self = shift;
86 3 50       10 return if $self->nytprofhtml_path;
87 3 50       28 my $nytprofhtml_path = File::Which::which('nytprofhtml')
88             or die "Could not find nytprofhtml script. Ensure it's in your path";
89 3         398 $self->nytprofhtml_path($nytprofhtml_path);
90             }
91              
92             sub _setup_profile_id {
93 3     3   6 my $self = shift;
94 2     2   74 $self->generate_profile_id( sub { return $$ . "-" . gettimeofday; } )
95 3 50       17 unless is_code_ref( $self->generate_profile_id );
96             }
97              
98             sub _setup_profiling_result_file_name {
99 3     3   6 my $self = shift;
100             $self->profiling_result_file_name(
101 1     1   11 sub { my $id = $_[1]->{PROFILE_ID}; return "nytprof.$id.out"; } )
  1         833  
102 3 100       14 unless is_code_ref( $self->profiling_result_file_name );
103             }
104              
105             sub _setup_nullfile_name {
106 3     3   7 my $self = shift;
107              
108 3 50       12 $self->nullfile_name('nytprof.null.out') unless $self->nullfile_name;
109             }
110              
111             sub _setup_profiling_hooks {
112 3     3   6 my $self = shift;
113 2     2   20 $self->before_profile( sub { } )
114 3 50       12 unless is_code_ref( $self->before_profile );
115 2     2   14 $self->after_profile( sub { } )
116 3 50       26 unless is_code_ref( $self->after_profile );
117              
118             }
119              
120             sub call {
121 3     3 1 3734329 my ( $self, $env ) = @_;
122              
123 3         21 $self->_setup_profiler($env);
124 3         22 $self->start_profiling_if_needed($env);
125              
126 3         732 my $res = $self->app->($env);
127              
128 3 50 33     208 if ( ref($res) && ref($res) eq 'ARRAY' ) {
129 3         16 $self->stop_profiling_and_report_if_needed($env);
130 3         31 return $res;
131             }
132              
133             Plack::Util::response_cb(
134             $res,
135             sub {
136 0     0   0 my $res = shift;
137             sub {
138 0         0 my $chunk = shift;
139 0 0       0 if ( !defined $chunk ) {
140 0         0 $self->stop_profiling_and_report_if_needed($env);
141 0         0 return;
142             }
143 0         0 return $chunk;
144             }
145 0         0 }
146 0         0 );
147             }
148              
149             sub start_profiling_if_needed {
150 3     3 0 13 my ( $self, $env ) = @_;
151 3         22 my $is_profiler_enabled = $self->enable_profile->($env);
152 3 100       22 return unless $is_profiler_enabled;
153              
154 2         11 $env->{PROFILER_ENABLED} = 1;
155 2         12 $self->before_profile->( $self, $env );
156 2         11 $self->start_profiling($env);
157             }
158              
159             sub stop_profiling_and_report_if_needed {
160 3     3 0 9 my ( $self, $env ) = @_;
161 3         9 my $is_profiler_enabled = $env->{PROFILER_ENABLED};
162 3 100       13 return unless $is_profiler_enabled;
163              
164 2         9 $self->stop_profiling($env);
165 2 50       15 $self->report($env) if $self->enable_reporting;
166 2         21 $self->after_profile->( $self, $env );
167             }
168              
169             sub _setup_profiler {
170 3     3   7 my ( $self, $env ) = @_;
171              
172 3         13 my $pid = $$;
173 3 50       18 return if $PROFILER_SETUPED{$pid};
174 3         9 $PROFILER_SETUPED{$pid} = 1;
175              
176 3         19 my $is_profiler_enabled = $self->enable_profile->($env);
177 3 100       25 return unless $is_profiler_enabled;
178              
179 2 50       11 return if $NYTPROF_LOADED;
180              
181 2   66     19 $ENV{NYTPROF} = $ENV{NYTPROF} || $self->env_nytprof || _default_env();
182 2         10653 require Devel::NYTProf;
183 2         5282 DB::disable_profile();
184 2         8 $NYTPROF_LOADED = 1;
185             }
186              
187             sub start_profiling {
188 2     2 0 7 my ( $self, $env ) = @_;
189              
190 2         12 $env->{PROFILE_ID} = $self->generate_profile_id->( $self, $env );
191 2         13 DB::enable_profile( $self->profiling_result_file_path($env) );
192             }
193              
194             sub stop_profiling {
195 2     2 0 81 DB::disable_profile();
196             }
197              
198             sub report {
199 0     0 0 0 my ( $self, $env ) = @_;
200              
201 0 0       0 return unless $env->{PROFILE_ID};
202              
203 0         0 DB::enable_profile( $self->nullfile_path );
204 0         0 DB::disable_profile();
205 0         0 my $profiling_result_file = $self->profiling_result_file_path($env);
206 0 0       0 return unless ( -f $profiling_result_file );
207 0         0 system $self->nytprofhtml_path, "-f", $profiling_result_file,
208             '-o', $self->report_dir->();
209             }
210              
211             sub profiling_result_file_path {
212 2     2 0 6 my ( $self, $env ) = @_;
213              
214 2         14 return File::Spec->catfile(
215             $self->profiling_result_dir->( $self, $env ),
216             $self->profiling_result_file_name->( $self, $env )
217             );
218             }
219              
220             sub nullfile_path {
221 0     0 0 0 my ( $self, $env ) = @_;
222              
223 0         0 return File::Spec->catfile( $self->profiling_result_dir->( $self, $env ),
224             $self->nullfile_name );
225             }
226              
227             sub is_code_ref {
228 18     18 0 354 my $ref = shift;
229 18 100       163 return ( ref($ref) eq 'CODE' ) ? 1 : 0;
230             }
231              
232             sub DESTROY {
233 3 100   3   3867758 DB::finish_profile() if defined &{"DB::finish_profile"};
  3         874  
234             }
235              
236             1;
237              
238             __END__