File Coverage

blib/lib/Log/Log4perl/Layout/JSON/Readable.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	5	6	83.3
condition	1	3	33.3
subroutine	8	8	100.0
pod	0	3	0.0
total	51	57	89.4

package Log::Log4perl::Layout::JSON::Readable;

use strict;
use warnings;
use parent 'Log::Log4perl::Layout::JSON';
our $VERSION = '1.0.1'; # VERSION
# ABSTRACT: JSON layout, but some fields always come first

use Class::Tiny +{
    first_fields => sub { [qw(time pid level)] },
};


sub BUILDARGS {
    my ($class, @etc) = @_;
    # the parent class does not have a BUILDARGS, but it may get one
    # in the future, let's handle both cases
    my $args = $class->maybe::next::method(@etc) || $etc[0];

    if (my $first_fields = delete $args->{first_fields}) {
        $args->{first_fields} = [
            grep { length }
                map { my $v = $_; $v =~ s/\s+//g; $v }
                split /\s*,\s*/,
            $first_fields->{value},
        ];
    }

    return $args;
}

# HACK!! the parent class Cs when it sees an argument it doesn't
# expect. To prevent that, we consume it first
sub BUILDALL {
    my ($self, $args, @etc) = @_;

    if (my $first_fields = delete $args->{first_fields}) {
        $self->first_fields($first_fields);
    }

    return $self->next::method($args,@etc);
}

sub render {
    my $self = shift;

    my $json = $self->SUPER::render(@_);

    if (my $first_fields = $self->first_fields) {
        for my $key (reverse @{$first_fields}) {
            _move_field_first(\$json, $key);
        }
    }

    return $json;
}

sub _move_field_first {
    my ($json_ref, $key) = @_;
    ${$json_ref} =~ s/^{(.+?),("$key":".+?")/\{$2,$1/;
    return;
}

1;

__END__