src/newslash_web/lib/Mojolicious/Plugin/NYTProf.pm

   1 package Mojolicious::Plugin::NYTProf;
   2
   3 =head1 NAME
   4
   5 Mojolicious::Plugin::NYTProf - Auto handling of Devel::NYTProf in your Mojolicious app
   6
   7 =for html
   8 <a href='https://travis-ci.org/Humanstate/mojolicious-plugin-nytprof?branch=master'><img src='https://travis-ci.org/Humanstate/mojolicious-plugin-nytprof.svg?branch=master' alt='Build Status' /></a>
   9 <a href='https://coveralls.io/r/Humanstate/mojolicious-plugin-nytprof?branch=master'><img src='https://coveralls.io/repos/Humanstate/mojolicious-plugin-nytprof/badge.png?branch=master' alt='Coverage Status' /></a>
  10
  11 =head1 VERSION
  12
  13 0.20
  14
  15 =head1 DESCRIPTION
  16
  17 This plugin enables L<Mojolicious> to automatically generate Devel::NYTProf
  18 profiles and routes for your app, it has been inspired by
  19 L<Dancer::Plugin::NYTProf>
  20
  21 =head1 SYNOPSIS
  22
  23   use Mojolicious::Lite;
  24
  25   plugin NYTProf => {
  26     nytprof => {
  27       ... # see CONFIGURATION
  28     },
  29   };
  30
  31   app->start;
  32
  33 Or
  34
  35   use Mojo::Base 'Mojolicious';
  36
  37   ...
  38
  39   sub startup {
  40     my $self = shift;
  41
  42     ...
  43
  44     my $mojo_config = $self->plugin('Config');
  45     $self->plugin(NYTProf => $mojo_config);
  46   }
  47
  48 Then run your app. Profiles generated can be seen by visting /nytprof and reports
  49 will be generated on the fly when you click on a specific profile.
  50
  51 =cut
  52
  53 use strict;
  54 use warnings;
  55
  56 use Mojo::Base 'Mojolicious::Plugin';
  57 use Time::HiRes 'gettimeofday';
  58 use File::Temp;
  59 use File::Which;
  60 use File::Spec::Functions qw/catfile catdir/;
  61
  62 our $VERSION = '0.20';
  63
  64 =head1 METHODS
  65
  66 =head2 register
  67
  68 Registers the plugin with your app - this will only do something if the nytprof
  69 key exists in your config hash
  70
  71   $self->register($app, \%config);
  72
  73 =head1 HOOKS AND Devel::NYTProf
  74
  75 The plugin adds hooks to control the level of profiling, Devel::NYTProf profiling
  76 is started using a before_routes hook and the stopped with an around_dispatch hook.
  77
  78 The consequence of this is that you should see profiling only for your routes and
  79 rendering code and will not see most of the actual Mojolicious framework detail.
  80
  81 You can override the hooks used to control when the profiling runs, see the
  82 CONFIGURATION section below.
  83
  84 =head1 CONFIGURATION
  85
  86 Here's what you can control in myapp.conf:
  87
  88   {
  89     # Devel::NYTProf will only be loaded, and profiling enabled, if the nytprof
  90     # key is present in your config file, so either remove it or comment it out
  91     # to completely disable profiling.
  92     nytprof => {
  93
  94       # path to your nytprofhtml script (installed as part of Devel::NYTProf
  95       # distribution). the plugin will do its best to try to find this so this
  96       # is optional, just set if you have a none standard path
  97       nytprofhtml_path => '/path/to/nytprofhtml',
  98
  99       # path to store Devel::NYTProf output profiles and generated html pages.
 100       # options, defaults to "/path/to/your/app/root/dir/nytprof"
 101       profiles_dir => '/path/to/nytprof/profiles/'
 102
 103       # set this to true to allow the plugin to run when in production mode
 104       # the default value is 0 so you can deploy your app to prod without
 105       # having to make any changes to config/plugin register
 106       allow_production => 0,
 107
 108       # Devel::NYTProf environment options, see the documentation at
 109       # https://metacpan.org/pod/Devel::NYTProf#NYTPROF-ENVIRONMENT-VARIABLE
 110       # for a complete list. N.B. you can't supply start or file as these
 111       # are used internally in the plugin so will be ignored if passed
 112       env => {
 113         trace => 1,
 114         log   => "/path/to/foo/",
 115         ....
 116       },
 117
 118       # when to enable Devel::NYTProf profiling - the pre_hook will run
 119       # to enable_profile and the post_hook will run to disable_profile
 120       # and finish_profile. the values show here are the defaults so you
 121       # do not need to provide these options
 122       #
 123       # bear in mind the caveats in the Mojolicious docs regarding hooks
 124       # and that they may not fire in the order you expect - this can
 125       # affect the NYTProf output and cause some things not to appear
 126       # (or appear in the wrong order). the defaults below should be
 127       # sufficient for profiling your code, however you can change these
 128       #
 129       # N.B. there is nothing stopping you reversing the order of the
 130       # hooks, which would cause the Mojolicious framework code to be
 131       # profiled, or providing hooks that are the same or even invalid. these
 132       # config options should probably be used with some care
 133       pre_hook  => 'before_routes',
 134       post_hook => 'around_dispatch',
 135     },
 136   }
 137
 138 =head1 nytprofhtml LOCATION
 139
 140 The plugin does its best to find the path to your nytprofhtml executable, if
 141 it cannot find it then it will die with an error. This also affects testing,
 142 and any tests will be skipped if they cannot find nytprofhtml allowing you to
 143 install the plugin - you will then need to make sure to set the path in your
 144 config using nytprofhtml_path
 145
 146 =cut
 147
 148 sub register {
 149   my ($self, $app, $config) = @_;
 150
 151   if (my $nytprof = $config->{nytprof}) {
 152
 153     return if $app->mode eq 'production' and ! $nytprof->{allow_production};
 154
 155     my $nytprofhtml_path;
 156
 157     if ( $nytprofhtml_path = $nytprof->{nytprofhtml_path} ) {
 158       # no sanity checking here, if a path is configured we use it
 159       # and don't fall through to defaults
 160     } else {
 161       $nytprofhtml_path = _find_nytprofhtml();
 162     }
 163
 164     $nytprofhtml_path && -e $nytprofhtml_path
 165       or die "Could not find nytprofhtml script. Ensure it's in your path, "
 166       . "or set the nytprofhtml_path option in your config.";
 167
 168     # Devel::NYTProf will create an nytprof.out file immediately so
 169     # we need to assign a tmp file and disable profiling from start
 170     my $prof_dir = $nytprof->{profiles_dir} || 'nytprof';
 171
 172     foreach my $dir ($prof_dir,catfile($prof_dir,'profiles')) {
 173       if (! -d $dir) {
 174         mkdir $dir
 175           or die "$dir does not exist and cannot create - $!";
 176       }
 177     }
 178
 179     # disable config option is undocumented, it allows testing where we
 180     # don't actually load or run Devel::NYTProf
 181     if (!$nytprof->{disable}) {
 182       # https://metacpan.org/pod/Devel::NYTProf#NYTPROF-ENVIRONMENT-VARIABLE
 183       # options for Devel::NYTProf - any can be passed but will always set
 184       # the start and file options here
 185       $nytprof->{env}{start} = 'no';
 186       s/([:=])/\\$1/g for grep{ defined() } values %{ $nytprof->{env} };
 187
 188       $ENV{NYTPROF} = join( ':',
 189         map { "$_=" . $nytprof->{env}{$_} }
 190           keys %{ $nytprof->{env} }
 191       );
 192
 193       require Devel::NYTProf;
 194     }
 195
 196     $self->_add_hooks($app, $config, $nytprofhtml_path);
 197   }
 198 }
 199
 200 sub _find_nytprofhtml {
 201   # fall back, assume nytprofhtml_path in same dir as perl
 202   my $nytprofhtml_path = $^X;
 203   $nytprofhtml_path =~ s/w?perl[\d\.]*(?:\.exe)?$/nytprofhtml/;
 204
 205   if ( ! -e $nytprofhtml_path ) {
 206     # last ditch attempt to find nytprofhtml, use File::Which
 207     # (last ditch in that it may return a different nytprofhtml
 208     # that is using a differently configured perl, e.g. system,
 209     # this may die with incompat config errorrs but at least try)
 210     $nytprofhtml_path = File::Which::which('nytprofhtml');
 211   }
 212
 213   return $nytprofhtml_path && -e $nytprofhtml_path
 214     ? $nytprofhtml_path : undef;
 215 }
 216
 217 sub _add_hooks {
 218   my ($self, $app, $config, $nytprofhtml_path) = @_;
 219
 220   my $nytprof   = $config->{nytprof};
 221   my $prof_dir  = $nytprof->{profiles_dir} || 'nytprof';
 222   my $pre_hook  = $nytprof->{pre_hook}     || 'before_routes';
 223   my $post_hook = $nytprof->{post_hook}    || 'around_dispatch';
 224   my $disable   = $nytprof->{disable}      || 0;
 225   my $log       = $app->log;
 226
 227   # add the nytprof/html directory to the static paths
 228   # so we can serve these without having to add routes
 229   push @{$app->static->paths},catfile($prof_dir,'html');
 230
 231   # put the actual profile files into a profiles sub directory
 232   # to avoid confusion with the *dirs* in nytprof/html
 233   my $prof_sub_dir = catfile( $prof_dir,'profiles' );
 234
 235   $app->hook($pre_hook => sub {
 236
 237     # figure args based on what the hook is
 238     my ($tx, $app, $next, $c, $path);
 239
 240     if ($pre_hook eq 'after_build_tx') {
 241       ($tx, $app) = @_[0,1];
 242       $path = $pre_hook; # TODO - need better identifier for this?
 243     } elsif ($pre_hook =~ /around/) {
 244       ($next, $c) = @_[0,1];
 245     } else {
 246       $c = $_[0];
 247       $path = $c->req->url->to_string;
 248       return if $c->stash->{'mojo.static'}; # static files
 249     }
 250
 251     return if $path =~ m{^/nytprof}; # viewing profiles
 252     $path =~ s!^/!!g;
 253     $path =~ s!/!-!g;
 254     $path =~ s![:?]!-!g if $^O eq 'MSWin32';
 255     $path =~ s!\?.*$!!g; # remove URL query params
 256
 257     my ($sec, $usec) = gettimeofday;
 258     my $profile = catfile($prof_sub_dir,"nytprof_out_${sec}_${usec}_${path}_$$");
 259     if($^O eq 'MSWin32' && length($profile)>259){
 260       my $overflow = length($profile) - 259;
 261       $path = substr($path, 0,length($path) - $overflow -1);
 262       $profile = catfile($prof_sub_dir,"nytprof_out_${sec}_${usec}_${path}_$$");
 263     }
 264     $log->debug( 'starting NYTProf' );
 265     # note that we are passing a custom file to enable_profile, this results in
 266     # a timing bug causing multiple calls to this plugin (in the order of 10^5)
 267     # to gradually slow down. see GH #5
 268     DB::enable_profile( $profile ) if ! $disable;
 269     return $next->() if $pre_hook =~ /around/;
 270   });
 271
 272   $app->hook($post_hook => sub {
 273     # first arg is $next if the hook matches around
 274     shift->() if $post_hook =~ /around/;
 275     DB::finish_profile() if ! $disable;
 276     $log->debug( 'finished NYTProf' );
 277   });
 278
 279   $app->routes->get('/nytprof/profiles/:file'
 280     => [file => qr/nytprof_out_\d+_\d+.*/]
 281     => sub {
 282       $log->debug( "generating profile for $nytprofhtml_path" );
 283       _generate_profile(@_,$prof_dir,$nytprofhtml_path)
 284     }
 285   );
 286
 287   $app->routes->get('/nytprof' => sub { _list_profiles(@_,$prof_sub_dir) });
 288 }
 289
 290 sub _list_profiles {
 291   my $self = shift;
 292   my $prof_dir = shift;
 293
 294   my @profiles = _profiles($prof_dir);
 295   $self->app->log->debug( scalar( @profiles ) . ' profiles found' );
 296
 297   # could use epl here, but users might be using a different Template engine
 298   my $list = @profiles
 299     ? '<p>Select a profile run output from the list to view the HTML reports as produced by <tt>Devel::NYTProf</tt>.</p><ul>'
 300     : '<p>No profiles found</p>';
 301
 302   foreach (@profiles) {
 303     $list .= qq{
 304       <li>
 305         <a href="$_->{url}">$_->{label}</a>
 306           (PID $_->{pid}, $_->{created}, $_->{duration})
 307       </li>
 308     };
 309   }
 310
 311   $list .= '</ul>' if $list !~ /No profiles found/;
 312
 313   my $html = <<"EndOfEp";
 314 <html>
 315   <head>
 316     <title>NYTProf profile run list</title>
 317   </head>
 318   <body>
 319     <h1>Profile run list</h1>
 320       $list
 321   </body>
 322 </html>
 323 EndOfEp
 324
 325   $self->render(text => $html);
 326 }
 327
 328 sub _profiles {
 329   my $prof_dir = shift;
 330
 331   require Devel::NYTProf::Data;
 332   opendir my $dirh, $prof_dir
 333       or die "Unable to open profiles dir $prof_dir - $!";
 334   my @files = grep { /^nytprof_out/ } readdir $dirh;
 335   closedir $dirh;
 336
 337   my @profiles;
 338
 339   for my $file ( sort {
 340     (stat catfile($prof_dir,$b))[10] <=> (stat catfile($prof_dir,$a))[10]
 341   } @files ) {
 342     my $profile;
 343     my $filepath = catfile($prof_dir,$file);
 344     my $label = $file;
 345     $label =~ s{nytprof_out_(\d+)_(\d+)_}{};
 346     my ($sec, $usec) = ($1,$2);
 347     $label =~ s{\.}{/}g;
 348     $label =~ s{/(\d+)$}{};
 349     my $pid = $1;
 350
 351     my ($nytprof,$duration);
 352     eval { $nytprof = Devel::NYTProf::Data->new({filename => $filepath}); };
 353
 354     $profile->{duration} = $nytprof && $nytprof->attributes->{profiler_duration}
 355       ? sprintf('%.4f secs', $nytprof->attributes->{profiler_duration})
 356       : '??? seconds - corrupt profile data?';
 357
 358     @{$profile}{qw/file url pid created label/}
 359       = ($file,"/nytprof/profiles/$file",$pid,scalar localtime($sec),$label);
 360     push(@profiles,$profile);
 361   }
 362
 363   return @profiles;
 364 }
 365
 366 sub _generate_profile {
 367   my $self = shift;
 368   my $htmldir = my $prof_dir = shift;
 369   my $nytprofhtml_path = shift;
 370
 371   my $file    = $self->stash('file');
 372   my $profile = catfile($prof_dir,'profiles',$file);
 373   return $self->reply->not_found if !-f $profile;
 374
 375   foreach my $sub_dir (
 376     $htmldir,
 377     catfile($htmldir,'html'),
 378     catfile($htmldir,'html',$file),
 379   ) {
 380     if (! -d $sub_dir) {
 381       mkdir $sub_dir
 382         or die "$sub_dir does not exist and cannot create - $!";
 383     }
 384   }
 385
 386   $htmldir = catfile($htmldir,'html',$file);
 387
 388   if (! -f catfile($htmldir, 'index.html')) {
 389     system($nytprofhtml_path, "--file=$profile", "--out=$htmldir");
 390
 391     if ($? == -1) {
 392       die "'$nytprofhtml_path' failed to execute: $!";
 393     } elsif ($? & 127) {
 394       die sprintf "'%s' died with signal %d, %s coredump",
 395         $nytprofhtml_path,,($? & 127),($? & 128) ? 'with' : 'without';
 396     } elsif ($? != 0) {
 397       die sprintf "'%s' exited with value %d",
 398         $nytprofhtml_path, $? >> 8;
 399     }
 400   }
 401
 402   $self->redirect_to("/${file}/index.html");
 403 }
 404
 405 =head1 AUTHOR
 406
 407 Lee Johnson - C<leejo@cpan.org>
 408
 409 =head1 LICENSE
 410
 411 This library is free software; you can redistribute it and/or modify it under
 412 the same terms as Perl itself. If you would like to contribute documentation
 413 please raise an issue / pull request:
 414
 415     https://github.com/Humanstate/mojolicious-plugin-nytprof
 416
 417 =cut
 418
 419 1;
 420
 421 # vim: ts=2:sw=2:et