File Coverage

blib/lib/WebService/Rollbar/Notifier.pm

Criterion	Covered	Total	%
statement	54	63	85.7
branch	15	20	75.0
condition	3	5	60.0
subroutine	15	19	78.9
pod	8	8	100.0
total	95	115	82.6

package WebService::Rollbar::Notifier;

use strict;
use warnings;

our $VERSION = '1.002010'; # VERSION

use Carp;
use Scalar::Util qw/blessed/;
use Mojo::Base -base;
use Mojo::UserAgent;

# HTTPS for some reason fails on Solaris, based on smoker tests
my $API_URL = ($^O eq 'solaris'?'http':'https').'://api.rollbar.com/api/1/';

has _ua => sub { Mojo::UserAgent->new; };
has callback => sub {
    ## Null by default, but not undef, because undef for callback
    ## means we want to block
};

has environment => 'production';
has [ qw/access_token  code_version framework language server/ ];

sub critical { my $self = shift; $self->notify( 'critical', @_ ); }
sub error    { my $self = shift; $self->notify( 'error',    @_ ); }
sub warning  { my $self = shift; $self->notify( 'warning',  @_ ); }
sub info     { my $self = shift; $self->notify( 'info',     @_ ); }
sub debug    { my $self = shift; $self->notify( 'debug',    @_ ); }

sub _parse_message_param {
    my $message = shift;

    if (ref($message) eq 'ARRAY') {
        return ($message->[0], $message->[1]||{});
    } else {
        return ($message, {} );
    }
}
sub report_message {
    my ($self) = shift;
    my ($message, $request_params) = @_;

    my ($body, $custom) = _parse_message_param($message);

    return $self->_post(
        {
            message => {
                body    => $body,
                %{ $custom },
            },
        },
        $request_params,
    );
}

sub notify {
    my $self = shift;
    my ( $severity, $message, $custom ) = @_;

    return $self->report_message( [$message, $custom], {level => $severity} );
}


my @frame_optional_fields =
    qw/lineno colno method code context argspec varargspec keywordspec locals /
;

sub _parse_exception_params {
    my @params = @_;

    my $request_params =
        ref $params[-1] eq 'HASH'
            ? pop @params
            : {}
    ;
    my $frames = _extract_frames(pop @params);

    my ($class, $message, $description) = @params;

    return (
        {
            class       => $class,
            (defined $message     ? (message => $message) : ()),
            (defined $description ? (description => $description) : ()),
        },
        $frames,
        $request_params,
    );
}
sub _devel_stacktrace_frame_to_rollbar {
    my $frame = shift;
    return {
        filename    => $frame->filename,
        lineno      => $frame->line,
        method      => $frame->subroutine,
        # code
        # context {}
        # varargspec: args
        # locals: { args => ... }
    }
}
sub _extract_frames {
    my $trace = shift;

    if ( ref($trace) eq 'ARRAY' ) {
        # Assume rollbar-ready frames
        return $trace;
    }
    if ( blessed($trace) and $trace->isa("Devel::StackTrace") ) {
        return [
            map { _devel_stacktrace_frame_to_rollbar( $_ ) }
                $trace->frames
        ];
    }

    return ();
}

sub report_trace {
    my $self = shift;

    my ($exception_data, $frames, $request_params) = _parse_exception_params(@_);

    return $self->_post(
        {
            trace => {
                exception   => $exception_data,
                frames      => $frames,
            }
        },
        $request_params,
    );
}

sub _post {
    my $self = shift;
    my ( $body, $request_optionals ) = @_;

    my @instance_optionals = (
        map +( defined $self->$_ ? ( $_ => $self->$_ ) : () ),
            qw/code_version framework language server/
    );
    my @request_optionals = (
        map +( exists $request_optionals->{$_} ? ( $_ => $request_optionals->{$_} ) : () ),
            qw/level context request person server client custom fingerprint uuid title/
    );

    my $response = $self->_ua->post(
        $API_URL . 'item/',
        json => {
            access_token => $self->access_token,
            data => {
                environment => $self->environment,

                body => $body,

                platform  => $^O,
                timestamp => time(),

                @instance_optionals,

                context => scalar( caller 3 ),

                @request_optionals,

                notifier => {
                    name => 'WebService::Rollbar::Notifier',
                    version => $VERSION,
                },

            },
        },

        ( $self->callback ? $self->callback : () ),
    );

    return $self->callback ? (1) : $response;
}


'
"Most of you are familiar with the virtues of a programmer.
 There are three, of course: laziness, impatience, and hubris."
                                                -- Larry Wall
';

__END__