File Coverage

blib/lib/Data/DTO/GELF.pm

Criterion	Covered	Total	%
statement	66	72	91.6
branch	4	6	66.6
condition			n/a
subroutine	18	19	94.7
pod	0	4	0.0
total	88	101	87.1

package Data::DTO::GELF;

# ABSTRACT: The DTO object for GELF version 1.1
our $VERSION = '1.7'; # VERSION 1.7
our $VERSION = 1.7;
use strict;
use warnings;

use Moose;
use namespace::autoclean;

use JSON::Tiny qw(encode_json);
use Sys::Hostname;
use Data::UUID;
use POSIX qw(strftime);

use Log::Log4perl;

use Data::DTO::GELF::Types qw( LogLevel );
use Devel::StackTrace;

our $GELF_VERSION = 1.1;

has 'version' => (
    is      => 'ro',
    isa     => 'Str',
    builder => '_build_version',
);

has 'host' => (
    is      => 'rw',
    isa     => 'Str',
    builder => '_build_host',
);

has 'short_message' => (
    is      => 'rw',
    isa     => 'Str',
    lazy    => 1,
    builder => '_long_to_short'
);

has 'full_message' => (
    is  => 'rw',
    isa => 'Str',
);

has 'timestamp' => (
    is      => 'ro',
    isa     => 'Int',
    builder => '_build_timestamp',
);

has 'level' => (
    is     => 'ro',
    isa    => LogLevel,
    coerce => 1,
);
has '_facility' => (
    is  => 'rw',
    isa => 'Str',
);

has '_line' => (
    is  => 'rw',
    isa => 'Int',
);

has '_file' => (
    is  => 'rw',
    isa => 'Str',
);

sub BUILD {
    my $self = shift;
    my $args = shift;
    foreach my $key1 ( keys %{$args} ) {
        if ( ( substr $key1, 0, 1 ) eq "_" ) {
            $self->meta->add_attribute( "$key1" => ( accessor => $key1 ) );
            $self->meta->get_attribute($key1)
                ->set_value( $self, $args->{$key1} );
        }
    }

    my $trace = Devel::StackTrace->new;
    foreach my $frame ( $trace->frames ) {
        if ( $frame->{subroutine} eq "Log::Log4perl::Logger::__ANON__" ) {
            $self->_line( $frame->{line} );
            $self->_file( $frame->{filename} );
            $self->_facility( $frame->{package} );
        }
    }

}

sub _build_version {
    my $self = shift;
    return "$GELF_VERSION";
}

sub _build_host {
    my $self = shift;
    return hostname();
}

sub _build_timestamp {
    my $self = shift;
    return time();
}

sub message {
    my $self = shift;
    my $m    = shift;
    if ( defined $m ) {
        $self->full_message($m);
    }
    else {
        return $self->full_message();
    }

    return;
}

sub _long_to_short {
    my $self = shift;
    my $msg  = $self->full_message();
    $msg =~ s/\n//sg;
    $msg =~ s/\s\s//sg;
    $msg = substr $msg, 0, 100;
    return $msg;
}

sub TO_HASH {
    my $self = shift;
    { $self->short_message() }    #fire off lazy message builder
    return {%$self};
}

sub TO_JSON {
    my $self = shift;
    { $self->short_message() }    #fire off lazy message builder
    return {%$self};
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::DTO::GELF - The DTO object for GELF version 1.1

=head1 VERSION

version 1.7

=head1 AUTHOR

Brandon "Dimentox Travanti" Husbands <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut