File Coverage

blib/lib/Plack/Middleware/Statsd.pm

Criterion	Covered	Total	%
statement	133	137	97.0
branch	37	54	68.5
condition	8	15	53.3
subroutine	23	23	100.0
pod	2	2	100.0
total	203	231	87.8

package Plack::Middleware::Statsd;

# ABSTRACT: send statistics to statsd

# RECOMMEND PREREQ: Net::Statsd::Tiny v0.3.0
# RECOMMEND PREREQ: HTTP::Status 6.16
# RECOMMEND PREREQ: List::Util::XS
# RECOMMEND PREREQ: Ref::Util::XS
# RECOMMEND PREREQ: Crypt::Mac::HMAC 0.089

use v5.20;
use warnings;

use parent qw/ Plack::Middleware /;

use List::Util qw/ first /;
use Module::Load;
use Plack::Util;
use Plack::Util::Accessor
    qw/ client sample_rate histogram increment set_add secure_set_add secure_set_key secure_set_hash catch_errors /;
use Ref::Util qw/ is_coderef /;
use Time::HiRes;
use Try::Tiny;

use experimental qw/ postderef signatures /;

our $VERSION = 'v0.9.1';

# Note: You may be able to omit the client if there is a client
# defined in the environment hash at C, and the
# L, L and L are set.  But that
# is a strange case and unsupported.

sub prepare_app($self) {

    if ( my $client = $self->client ) {
        foreach my $init (
            [qw/ histogram timing_ms timing /],
            [qw/ increment increment /],
            [qw/ set_add   set_add   /],
          )
        {
            my ( $attr, @methods ) = $init->@*;
            next if defined $self->$attr;
            my $method = first { $client->can($_) } @methods;
            warn "No $attr method found for client " . ref($client)
                unless defined $method;
            $self->$attr(
                sub($env, @args) {
                    return unless defined $method;
                    try {
                        $client->$method( grep { defined $_ } @args );
                    }
                    catch {
                        my ($e) = $_;
                        if (my $logger = $env->{'psgix.logger'}) {
                            $logger->( { message => $e, level => 'error' } );
                        }
                        else {
                            $env->{'psgi.errors'}->print($e);
                        }
                    };

                }
            );
        }

        my $hash = $self->secure_set_hash || "SHA1";
        if ( my $key = $self->secure_set_key ) {
            load Crypt::Mac::HMAC;
            $self->secure_set_add(
                sub( $env, $metric, $string ) {
                    my $obscure = Crypt::Mac::HMAC::hmac_b64u( $hash, $key, $string );
                    $self->set_add->( $env, $metric, $obscure );
                }
            );
        }

    }

    if (my $attr = first { !is_coderef($self->$_) } qw/ histogram increment set_add /) {
        die "$attr is not a coderef";
    }

    if ( my $catch = $self->catch_errors ) {

        unless ( is_coderef($catch) ) {

            $self->catch_errors(
                sub( $env, $error ) {
                    if ( my $logger = $env->{'psgix.logger'} ) {
                        $logger->( { level => 'error', message => $error } );
                    }
                    else {
                        $env->{'psgi.errors'}->print($error);
                    }
                    my $message = 'Internal Error';
                    return [ 500, [ 'Content-Type' => 'text/plain', 'Content-Length' => length($message) ], [$message] ];
                }
            );

        }

    }
}

sub call ( $self, $env ) {

    my $client = ( $env->{'psgix.monitor.statsd'} //= $self->client );
    my $secure = $self->secure_set_add;

    $env->{'psgix.monitor.statsd_secure_set_add'} = sub { $secure->( $env, @_ ) } if defined $secure;

    my $start = [Time::HiRes::gettimeofday];
    my $res;

    if (my $catch = $self->catch_errors) {
        try {
            $res = $self->app->($env);
        }
        catch {
            $res = $catch->( $env, $_ );
        }
    }
    else {
        $res = $self->app->($env);
    }

    return Plack::Util::response_cb(
        $res,
        sub($res) {
            return unless $client;

            my $rate = $self->sample_rate;

            $rate = undef if ( defined $rate ) && ( $rate >= 1 );

            my $histogram = $self->histogram;
            my $increment = $self->increment;
            my $set_add   = $self->set_add;

            my $elapsed = Time::HiRes::tv_interval($start);

            $histogram->( $env, 'psgi.response.time', $elapsed * 1000, $rate );

            if ( defined $env->{CONTENT_LENGTH} ) {
                $histogram->( $env,
                    'psgi.request.content-length',
                    $env->{CONTENT_LENGTH}, $rate
                );
            }

            if ( my $method = $env->{REQUEST_METHOD} ) {
                $method = "other" unless $method =~ /^\w+$/a;
                $increment->( $env, 'psgi.request.method.' . $method, $rate );
            }

            if ( my $type = _mime_type_to_metric( $env->{CONTENT_TYPE} ) ) {
                $increment->( $env, 'psgi.request.content-type.' . $type, $rate );
            }

            $secure->( $env, 'psgi.request.remote_addr', $env->{REMOTE_ADDR} )
                if defined($secure) && $env->{REMOTE_ADDR};

            $set_add->( $env, 'psgi.worker.pid', $$ );

            my $h = Plack::Util::headers( $res->[1] );

            my $xsendfile =
                 $env->{'plack.xsendfile.type'}
              || $ENV{HTTP_X_SENDFILE_TYPE}
              || 'X-Sendfile';

            if ( $h->exists($xsendfile) ) {
                $increment->( $env, 'psgi.response.x-sendfile', $rate );
            }

            if ( $h->exists('Content-Length') ) {
                my $length = $h->get('Content-Length') || 0;
                $histogram->( $env, 'psgi.response.content-length', $length, $rate );
            }

            if ( my $type = _mime_type_to_metric( $h->get('Content-Type') ) ) {
                $increment->( $env, 'psgi.response.content-type.' . $type, $rate );
            }

            $increment->( $env, 'psgi.response.status.' . $res->[0], $rate );

            if (
                  $env->{'psgix.harakiri.supported'}
                ? $env->{'psgix.harakiri'}
                : $env->{'psgix.harakiri.commit'}
              )
            {
                $increment->( $env, 'psgix.harakiri' );    # rate == 1
            }

            $client->flush if $client->can('flush');

            return;
        }
    );

}

sub _mime_type_to_metric( $type = undef ) {
    return unless $type;
    return unless $type =~ m#^\w+/(?:\w+[\-\+])*\w+(?: *;\w+=\w+)?#a;
    return $type =~ s#\.#-#gr =~ s#/#.#gr =~ s/;.*$//r;
}


1;

__END__