File Coverage

blib/lib/Plack/Middleware/LogStderr.pm

Criterion	Covered	Total	%
statement	71	80	88.7
branch	22	30	73.3
condition	17	25	68.0
subroutine	18	20	90.0
pod	2	2	100.0
total	130	157	82.8

use strict;
use warnings;
package Plack::Middleware::LogStderr;
$Plack::Middleware::LogStderr::VERSION = '0.002';
# ABSTRACT: Everything printed to STDERR sent to psgix.logger or other logger
# KEYWORDS: plack middleware errors logging environment I/O handle stderr

use parent 'Plack::Middleware';

use Plack::Util::Accessor qw/logger callback tie_callback capture_callback no_tie log_level log_level_capture no_warnings/;
use Scalar::Util ();
use Capture::Tiny 'capture_stderr';

sub prepare_app {
    my $self = shift;
    $self->{log_level} = $self->log_level || 'error';
    $self->{log_level_capture} = $self->log_level_capture || $self->{log_level} ;

    foreach my $cb (qw/logger callback tie_callback capture_callback/){
        if ($self->$cb) {
            if (not __isa_coderef($self->$cb)) {
                die "'$cb' is not a coderef!"
            }
        }
    }
}

sub call {
    my ($self, $env) = @_;
    my $logger = $self->logger || $env->{'psgix.logger'};

    die 'no psgix.logger in $env; cannot send STDERR to it!'
        if not $logger;

    my $stderr_logger = sub {
        my $message = shift;
        $message = $self->__run_tie_callback($message);
        $logger->({level => $self->{log_level}, message => $message });
    };

    my ($stderr, @app) = capture_stderr {
        my ($app, $err);

        tie *STDERR, 'Plack::Middleware::LogStderr::Handle2Logger', $stderr_logger, $self->no_warnings
            unless $self->no_tie ;

        eval {
            $app =  $self->app->($env);
        };
        $err = $@ if $@;

        untie *STDERR
            unless $self->no_tie ;

        if ($err) {
            die $@;
        }
        return $app;
    };
    if ($stderr) {
        $stderr = $self->__run_capture_callback($stderr) ;
        $logger->({level => $self->{log_level_capture}, message => $stderr });
    }

    return $app[0];
}

sub __run_callback {
    my ($self, $msg, $extra_cb) = @_;
    $msg = $self->callback->($msg) if $self->callback;
    if ($extra_cb) {
        if ($extra_cb eq 'tie' && $self->tie_callback) {
            $msg = $self->tie_callback->($msg) ;
        }
        if ($extra_cb eq 'capture' && $self->capture_callback) {
            $msg = $self->capture_callback->($msg) ;
        }
    }
    return $msg;
}
sub __run_capture_callback {
    my ($self, $msg) = @_;
    $msg = $self->__run_callback($msg, 'capture');
    return $msg;

}
sub __run_tie_callback {
    my ($self, $msg) = @_;
    $msg = $self->__run_callback($msg, 'tie');
    return $msg;
}

sub __isa_coderef {
    ref $_[0] eq 'CODE'
        or (Scalar::Util::reftype($_[0]) || '') eq 'CODE'
        or overload::Method($_[0], '&{}')
}

package # hide from PAUSE
    Plack::Middleware::LogStderr::Handle2Logger;
our $VERSION = '0.001';
# ABSTRACT: Tie File Handle to a logger
use warnings::register;

sub TIEHANDLE {
    my ($pkg, $logger, $no_warnings) = @_;
    return bless {logger => $logger, no_warnings => $no_warnings}, $pkg;
}
sub PRINT {
    my ($self, @msg) = @_;
    my $message = join('', @msg);
    $self->{logger}->( $message );
}
sub PRINTF {
    my ($self, $fmt, @msg) = @_;
    my $message = sprintf($fmt, @msg);
    $self->{logger}->($message);
}
## if something tries to reopen FILEHANDLE just return true -- noop
sub OPEN {
    my ($self) = @_;
    if (warnings::enabled() && !$self->{no_warnings}) {
        warnings::warn("open called on tied handle Handle2Logger");
    }
    return 1;
}
## if something tries to set BINMODE -- noop
sub BINMODE {
    my ($self) = @_;
    if (warnings::enabled() && !$self->{no_warnings}) {
        warnings::warn("binmode called on tied handle Handle2Logger");
    }
    return undef;
}


1;

__END__