BenchmarkerBuilder.pm

package Plack::BenchmarkerBuilder;
use strict;
use warnings;
use parent 'Plack::Builder';

use Time::HiRes 'time';

sub import {
    my $class = shift;
    Plack::Builder->export_to_level(1, @_);
}

my $add_middleware = sub {
    my($self, $mw, @args) = @_;

    if (ref $mw ne 'CODE') {
        my $mw_class = Plack::Util::load_class($mw, 'Plack::Middleware');
        $mw = [ $mw_class, sub { $mw_class->wrap($_[0], @args) }];
    } else {
        $mw = ['CODE', $mw];
    }

    push @{$self->{middlewares}}, $mw;
};

my $add_middleware_if = sub {
    my($self, $cond, $mw, @args) = @_;

    if (ref $mw ne 'CODE') {
        my $mw_class = Plack::Util::load_class($mw, 'Plack::Middleware');
        $mw = [$mw_class, sub { $mw_class->wrap($_[0], @args) }];
    } else {
        $mw = ['CODE', $mw];
    }

    push @{$self->{middlewares}}, sub {
        Plack::Middleware::Conditional->wrap($_[0], condition => $cond, builder => $mw);
    };
};

my $to_app = sub {
    my($self, $app) = @_;
    for my $attr (reverse @{$self->{middlewares}}) {
        my($class, $mw) = @{ $attr };
        my $c = $app;
        $app = $mw->(sub {
            my $start = time() * 1000;
            my $res = $c->(@_);
            my $end = time() * 1000;
            warn sprintf 'MIDDLEWARE END %s (%sms)', $class, (int(($end - $start) * 1000) / 1000);
            $res;
        });
    }
    $app;
};

{
    package Plack::Builder;
    no warnings 'redefine';
    *add_middleware    = $add_middleware;
    *add_middleware_if = $add_middleware_if;
    *to_app            = $to_app;
}
1;
__END__
=head1 NAME

Plack::BenchmarkerBuilder - Plack::Builder with Middleware benchmark

=head1 SYNOPSIS

  use strict;
  use warnings;
  use Plack::BenchmarkerBuilder;
  use Data::Dumper;
  
  builder {
      enable 'AccessLog';
      enable 'AccessLog';
      enable 'AccessLog';
      enable sub {
          my $app = shift;
          sub {
              my $env = shift;
              my @x = caller(0);
              warn Dumper(\@x);
              $app->($env);
          };
      };
  
      sub {
          [ 404, [], ['no'] ];
      };
  };


=head1 SEE ALSO

L<http://mirakui.hatenablog.com/entry/2012/04/03/slow-middleware>

=cut