File Coverage

/root/.cpan/build/Sentry-0.01-0/blib/lib/Sentry.pm

Criterion	Covered	Total	%
statement	45	58	77.5
branch	4	14	28.5
condition	9	24	37.5
subroutine	12	19	63.1
pod	1	7	14.2
total	71	122	58.2

# ABSTRACT: Yet another lightweight Sentry client

package Sentry;
$Sentry::VERSION = '0.01';


use LWP::UserAgent;
use MIME::Base64 'encode_base64';
use Sys::Hostname;
use POSIX;
use JSON::XS;
use Sub::Name;
use Carp;
use Class::Tiny;

my @LEVELS;

BEGIN {
    @LEVELS = qw( fatal error warning warn info debug );
    no strict 'refs';
    for my $level (@LEVELS) {
        *{ __PACKAGE__ . "::$level" } = subname $level =>
          sub { shift->_send( message => shift, level => $level, @_ ) };
    }
}

my @INTERFACES = (
    'exception',  'stacktrace', 'template', 'breadcrumbs',
    'contexts',   'request',    'threads',  'user',
    'debug_meta', 'repos',      'sdk'
);


sub new {
    my ( $class, $dsn, %params ) = @_;

    die 'API key is not defined' unless $dsn;

    my $self = {
        ua => LWP::UserAgent->new( timeout => 10 ),
        sentry_version => $params{sentry_version} || 7,
        %params,
    };

    (
        my $protocol, $self->{public_key}, $self->{secret_key},
        my $host_path,
        my $project_id
      )
      = $dsn =~ m{^ ( https? ) :// ( \w+ ) : ( \w+ ) @ ( .+ ) / ( \d+ ) $}ixaa;

    die 'Wrong dsn format'
      if grep { !defined $_ || !length $_ } (
        $protocol, $self->{public_key}, $self->{secret_key}, $host_path,
        $project_id
      );

    $self->{uri} = "$protocol://$host_path/api/$project_id/store/";

    bless $self, $class;
}

# Send a message to Sentry server.
# Returns the id of inserted message or dies.

sub _send {
    my ( $self, %params ) = @_;

    my $auth = sprintf
'Sentry sentry_version=%s, sentry_timestamp=%s, sentry_key=%s, sentry_client=%s, sentry_secret=%s',
      $self->{sentry_version},
      time(),
      $self->{public_key},
      __PACKAGE__,
      $self->{secret_key},
      ;

    my $message = $self->_build_message(%params);
    $message = encode_json $message;
    my $response = $self->{ua}->post(
        $self->{uri},
        'X-Sentry-Auth' => $auth,
        'Content-Type'  => 'application/json',
        Content         => encode_base64($message),
    );

    unless ( $response->is_success ) {
        if ( int( $response->code / 100 ) == 4 ) {
            die $response->status_line . ': ' . $response->decoded_content;
        }

        die $response->status_line;
    }

    my $answer_ref = decode_json $response->decoded_content;

    die 'Wrong answer format' unless $answer_ref && $answer_ref->{id};

    return $answer_ref->{id};
}

sub _build_message {
    my ( $self, %params ) = @_;

    die 'No message given'
      unless defined $params{message} && length $params{message};

    my $data_ref = {
        message   => $params{message},
        timestamp => strftime( '%FT%X.000000Z', gmtime time ),
        level     => $params{level} || $self->{level} || 'info',
        logger    => $params{logger},
        platform => $params{platform} || 'perl',
        culprit  => $params{culprit}  || '',
        tags => { %{ $self->{tags} }, %{ $params{tags} } } || {},
        server_name => $params{server_name} || hostname(),
        modules     => $params{modules},
        extra       => $params{extra}       || {},
    };

    for (@INTERFACES) {
        $data_ref->{$_} => $params{$_} if $params{$_};
    }

    return $data_ref;
}

1;

__END__